$IBFTC ABLATE
      SUBROUTINE ABLATE (H1)                                                   1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATIONS USED FOR THE RATES OF MELT ARE DEFINED IN         62
C****         SECTION II, PART C.                                             63
      H = H1                                                                  64
C****              IF H = 0.,CALCULATE SPC AND SPM.                           65
C****              IF H = NUMBER, COMPUTE SC AND SM.                          66
      KT = KONVAR(2)                                                          67
      IF (TMELT(1)) 5,4,5                                                     68
    4 SPM = 0.0                                                               69
      SPC = 0.0                                                               70
      GO TO 900                                                               71
    5 KMELT = KONVAR(8)                                                       72
      CTIME = CTIME                                                           73
      II = KONVAR(6)*KONVAR(1)+1                                              74
      TW = T(II)                                                              75
      IF (H) 800,10,800                                                       76
C****         SPC IS DEFINED IN SECTION II, PARTC, SUB-PART 1,B.              77
   10 SPC = EMDG(1)/(DENSE(1)-CHART(2))                                       78
      IF(GENRL(9)) 20,30,20                                                   79
   20 SPC = TRAJV(50)*SPC/(TRAJV(50) -HTCONV(8))                              80
   30 GO TO (100,200,300,400,500,600,700),KMELT                               81
C****              EFN 100 STARTS THE FIXED CHAR                              82
C****                   LENGTH OPTION.                                        83
  100 CALL TABUP(HORA,TTABL,CTIME,SCM,INDTL(5),7)                             84
      SX = (SCHAR(KT+1)-SMELT(KT+1)) - SCM                                    85
      IF (SX) 115,115,118                                                     86
  115 SPM = 0.                                                                87
      GO TO 900                                                               88
  118 CALL TABUP(HORA,TTABL,CTIME,SPCM,INDTL(5),8)                            89
      SPM = SPC - SPCM                                                        90
      GO TO 900                                                               91
C****              EFN 200 STARTS THE GRAPHITE                                92
C****                   SUBLIMATION OPTION.                                   93
  200 IF (TW-1800.) 210,215,215                                               94
  210 SPM = 0.                                                                95
      GO TO 900                                                               96
  215 KONVAR(9) = 1                                                           97
      CALL QNET                                                               98
      KONVAR(9) = 0                                                           99
C****              TIVAR VALUES ARE COMPUTED IN QNET.                        100
      CALL TABUP(WARM,HTABL,TW,CPBL,INDTL(4),1)                              101
      DMD = HTCONV(6)/(TIVAR(7)+TIVAR( 8)*(TIVAR(2)-CPBL*TW))                102
      EXP1 = -11.05E4/TW                                                     103
  220 IF(ABS(CHART(4)) - CTIME) 230, 230, 225                                104
  225 IF(CHART(4)) 250, 250, 240                                             105
  230 IF(CHART(4)) 240, 250, 250                                             106
  240 DMT = (1.+2.64E9*TIVAR(4)**(-.67)*EXP(EXP1))*DMD                       107
      GO TO 260                                                              108
  250 DMT = (1. + HTCONV(10)*( 6.7 + HTCONV(10)*11.))*DMD                    109
  260 SPM = DMT/DENS(II)                                                     110
      GO TO 900                                                              111
C****              EFN 300 STARTS THE REFRASIL OPTION.                       112
  300 EXP1 = -TMELT(4)/TW                                                    113
      SPM = TMELT(2)*TW**TMELT(3)*EXP (EXP1)                                 114
      GO TO 900                                                              115
C****         EFN 400 STARTS THE GRAPHITE AT STAGNATION PT. OPTION.          116
C****         GET  PE  FROM THE T-TABLE                                      117
  400 CALL TABUP(HORA,TTABL ,CTIME,PE,INDTL(5),2)                            118
C****         GET  CHLR.                                                     119
      RNOSE = TMELT(6)                                                       120
      IF (TMELT(7))  402,403,402                                             121
  402 CALL TABUP(HORA,TTABL ,CTIME,CHLR,INDTL(5),4)                          122
      GO TO 405                                                              123
  403 CALL CRATIO (TRAJV(18),CHLR)                                           124
  405 RMDOT = TMELT(3)*SQRT(.21* PE/2116.) *EXP(-TMELT(2)/(1.104*TW))        125
  410 DMDOT = TMELT(4)*CHLR*SQRT(PE/2116.*1./RNOSE)                          126
  415 CSUBCW = .15*   (RMDOT**2/(RMDOT**2+DMDOT**2))**.5 + 2.4E6*1./         127
     1(PE/2116.)**.67 *EXP(-11.1E4 /TW)                                      128
  420 WMDOT = .0425*CSUBCW*CHLR*TMELT(5)*SQRT(PE/2116.*1./RNOSE)             129
  425 SPM = WMDOT/DENS(II)                                                   130
      AUS(1) = CHLR                                                          131
      AUS(2) = CSUBCW                                                        132
      AUS(3) = 1./(TMELT(3)*SQRT(RNOSE)/100.)**4                             133
  430 IF(AUS(3).GE.PE/2116.) GO TO 435                                       134
      AUS(3) = -AUS(3)                                                       135
  435 GO TO 900                                                              136
C****         THAT ENDS THIS OPTION.                                         137
C****              EFN 500 STARTS THE FIXED MELTING T                        138
C****                   OPTION.                                              139
  500 IF(TW-TMELT(2)+ABS(EPTAB(3))) 510,515,514                              140
  510 SPM = 0.                                                               141
      GO TO 900                                                              142
  514 T(II) = TMELT(2)                                                       143
  515 TD = -3.*T(II)+4.*T(II+1)-T(II+2)                                      144
      TX = TD/2./DELETA(1)                                                   145
      CALL CHARP(II,1)                                                       146
      CALL TABUP(WARM,PROPT,TMELT(2),CAY,INDTL(4),2)                         147
      KT = KONVAR(2)+1                                                       148
      CALL QNET                                                              149
      TQ = -CHARV(1)*CAY*TX*SPACVR(3)/THIKN(1)                               150
      EPS = -EPTAB(6)                                                        151
      TSPM = SPM                                                             152
C****         GAMMA AND RHOL ARE IN TIVAR(6) AND (7)                         153
C***               AND WERE LOOKED UP IN QNET.                               154
      GRHOL = TIVAR(6) * TIVAR(7)                                            155
      HRMHW = TIVAR(2) - HEVAR(1) * T(II)                                    156
      QC = Q(KT,4)                                                           157
  520 SMVMG = TIVAR(7) * DENS(II) * SPM + EMDG(1)                            158
      CALL QBLK(QC,HRMHW,QBKSTR,SMVMG)                                       159
      QVAP = GRHOL * SPM                                                     160
      IF(TIVAR(7)) 523, 522, 523                                             161
  522 GRHOL = TIVAR(6)                                                       162
  523 SPM = (Q(KT,1) + Q(KT,5) - TQ - QBKSTR)/GRHOL                          163
      IF(TIVAR(7)) 524,540,524                                               164
  524 CALL TNEST(SPM,TSPM,EPS)                                               165
      KSPM = TSPM                                                            166
      EPS = ABS(EPS)                                                         167
      GO TO (540,527,530),KSPM                                               168
  527 SPM = AMAX1 (0.0,SPM)                                                  169
      GO TO 520                                                              170
  530 WRITE(6,1200) EMV,SPM,TQ,QBKSTR,QC,HRMHW                               171
      GO TO 520                                                              172
  540 Q(KT,1) = TQ                                                           173
      Q(1,13) = QVAP                                                         174
      Q(KT,5) = QBKSTR                                                       175
      GO TO 900                                                              176
C****    EFN 600 STARTS THE DEPOLYMERIZATION OPTION                          177
  600 CALL DEPOLY(SPM)                                                       178
      GO TO 900                                                              179
C****    EFN 700 STARTS A COMBINATION GRAPHITE SUBLIMATION AND               180
C****    FIXED MELTING OPTION                                                181
  700 IF(TW-TMELT(3)) 200,200,500                                            182
C****         THE EQUATIONS FOR THE AMOUNTS OF MELT AND CHAR                 183
C****         ARE DISCUSSED IN SECTION II, PART C, SUB-PART 1,B.             184
C****              EFN 800 STARTS THE COMPUTATIONS FOR THE                   185
C****                   AMOUNT OF CHAR AND MELT.                             186
  800 KT = KONVAR(2)                                                         187
      SCHAR(KT+1) = SCHAR(KT) + H*HTCONV(4)                                  188
      RHOB = .97*DENSE(1)                                                    189
      INDTL(6) = PTSIN(1) + 1.                                               190
      IF(DENS(II)-RHOB) 809, 809, 804                                        191
  804 SSTAR = SCHAR(KT)                                                      192
      GO TO 815                                                              193
  809 IF(CHART(12)) 810,815,810                                              194
  810 CALL TABUP(DENS(II),XLOC,RHOB,SSTAR,INDTL(6),1)                        195
  815 HTCONV(8) = SCHAR(KT+1)+CHART(12)*(SSTAR-SCHAR(KT+1))                  196
      SMELT(KT+1) = SMELT(KT)+H*HTCONV(5)                                    197
      HTCONV(7) = SMELT(KT+1)                                                198
      THIKN(1) = HTCONV(9)-HTCONV(7)                                         199
      GO TO 998                                                              200
C**** EFN 900 SETS UP STORAGE FOR SPM AND SPC                                201
  900 HTCONV(5) = SPM                                                        202
      HTCONV(4) = SPC                                                        203
  998 RETURN                                                                 204
 1200 FORMAT(1H0,4X,5HMV = E15.8,3X,6HSPM = E15.8,3X,5HTQ = E15.8,3X,9HQ     205
     1BKSTR = E15.8//5X,5HQC = E15.8,3X8HHRMHW = E15.8//)                    206
      STOP                                                                   207
      END                                                                    208
$IBFTC AQNET
      SUBROUTINE QNET                                                          1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION THR(15),S(16)                                                 62
      DIMENSION HWTEMP(12),HWPRES(7),HWRTAB(12,7)                             63
      DATA THR/ 0.,2000.,3000.,4000.,5000.,6000.,7000.,8000.,9000.,           64
     110000.,11000.,12000.,13000.,14000.,160000./                             65
      DATA S/ 14.8,10.8,8.75,6.90,5.60,4.60,3.95,3.50,3.10,2.85,              66
     12.65,2.52,2.42,2.38,2.38,1.0/                                           67
      DATA HWTEMP/0.,3500.,3600.,4000.,4500.,5000.,5500.,6000.,6500.,         68
     17000.,7500.,8000./                                                      69
      DATA HWPRES/0.,.001,.01,.1,1.,10.,100./                                 70
      DATA HWRTAB/910.,910.,1020.,1290.,1900.,2670.,3100.,3330.,3550.,        71
     13900.,4500.,5500.,910.,910.,1020.,1290.,1900.,2670.,3100.,3330.,        72
     23550.,                                                                  73
     33900.,4500.,5500.,910.,910.,1000.,1170.,1500.,2100.,2770.,3210.,        74
     43450.,3700.,4000., 4480.,910.,910.,990.,1130.,1350.,1700.,2190.,        75
     52770.,3230.,3550.,3820.,4100.,910.,910.,990.,1120.,1310.,1540.,         76
     61840.,2240.,2680.,3140.,3540.,3840.,910.,910.,990.,1110.,1280.,         77
     71470.,1690.,1960.,2250.,2630.,3020.,3440.,910.,910.,990.,1110.,         78
     81280.,1450.,1650.,1860.,2070.,2310.,2590.,2900./                        79
C****         ENTRY 16 IN THE S TABLE IS JUST FOR THE USE OF TABUP.           80
C****         THE 1.0 INDICATES THAT THE TABLE IS VARIABLE.                   81
C****         THE EQUATIONS USED IN THE QNET ROUTINE ARE DISCUSSED AND        82
C****         DEFINED IN SECTION II.C                                         83
      TEMPO = CTIME                                                           84
      II = KONVAR(6)*KONVAR(1)+1                                              85
      TW = T(II)                                                              86
      CALL TABUP(HORA,TTABL,TEMPO,TIVAR,INDTL(5),-8)                          87
      KMELT = KONVAR(8)                                                       88
      IF (GENRL(5)) 5,30,30                                                   89
C****              COMPUTATION FOR QNET WITH FRONT FACE                       90
C****                   T READ IN TTABL(1).                                   91
    5 CALL TABUP(WARM,PROPT,TW,CAY,INDTL(4),2)                                92
      TX = -3.*T(II)+4.*T(II+1)-T(II+2)                                       93
      QNET = -CAY*SPACVR(3)/THIKN(1)*TX/2./DELETA(1)                          94
      QRR = 0.0                                                               95
      QHGR = 0.0                                                              96
      QC = 0.0                                                                97
      QBLOCK = 0.0                                                            98
      GO TO 900                                                               99
C****              QC OR QC/DH IS IN TTABL(1)                                100
   30 CALL TABUP(WARM,HTABL,TW,HEVAR,INDTL(4),-3)                            101
      QRR = HEVAR(2)*HTCONV(2)*TW**4                                         102
      IF (KMELT-4) 35,400,35                                                 103
   35 QHGR = TIVAR(3)                                                        104
      QC = TIVAR(1)                                                          105
      HW = HEVAR(1)*TW                                                       106
      HRMHW = TIVAR(2)-HW                                                    107
      IF (GENRL(5)) 40,45,40                                                 108
   40 QC = QC*HRMHW                                                          109
   45 IF (CHART(1)) 65,60,65                                                 110
   60 QBLOCK = 0.                                                            111
      GO TO 90                                                               112
   65 CALL QBLK(QC,HRMHW,QBLOCK,EMDG(1))                                     113
   90 QNET = QC+QHGR-QRR-QBLOCK                                              114
      IF(KMELT) 95, 100, 95                                                  115
   95 GO TO (100,200,300,400,500,600,700),KMELT                              116
C****              EFN 100 STARTS THE FIXED CHAR LENGTH                      117
C****                   OPTION.                                              118
C****         QNET IN THIS OPTION IS DEFINED IN II.C.1                       119
  100 CONTINUE                                                               120
      GO TO 900                                                              121
C****              EFN 200 STARTS THE GRAPHITE SUBLIMATION                   122
C****                   OPTION.                                              123
C****         QNET IN THIS OPTION IS DEFINED IN II.C.2                       124
  200 HTCONV(6) = QC                                                         125
      EXP1 = -11.05E4/TW                                                     126
      QSTR = 3.96E8*TIVAR(4)**(-.67)*EXP(EXP1)                               127
      HTCONV(10) = QSTR                                                      128
C****              IF KONVAR(9) = 1, THE ROUTINE WAS CALLED                  129
C****                   FROM THE ABLATE ROUTINE FOR QC.                      130
      IF (KONVAR(9)) 998,220,998                                             131
  220 IF(ABS(CHART(4)) - TEMPO) 230, 230, 225                                132
  225 IF(CHART(4)) 250, 250, 240                                             133
  230 IF(CHART(4)) 240, 250, 250                                             134
  240 CALL TABUP(THR,S,TIVAR(2),HRS,15,1)                                    135
      GO TO 260                                                              136
  250 HR = TIVAR(2)                                                          137
      HRS = 26.781 + HR*(-7.9902E-3 + HR*(1.1199E-6 + HR*(-7.4989E-11 +      138
     1HR*1.9445E-15)))                                                       139
  260 QCP = QC*(1.-HRS*QSTR)                                                 140
      Q(2,13) = QCP                                                          141
      CALL QBLK(QCP,HRMHW,QBLOCK,EMDG(1))                                    142
      QNET = QCP+QHGR-QRR-QBLOCK                                             143
      GO TO 900                                                              144
C****              EFN 300 STARTS THE REFRASIL OPTION                        145
C****         QNET IN THIS OPTION IS DEFINED IN II.C.3                       146
  300 QNET = QC+QHGR-QRR-QBLOCK-HTCONV(5)*TIVAR(6)                           147
      GO TO 900                                                              148
C****         EFN 400 STARTS THE GRAPHITE AT STAGNATION PT. OPTION.          149
C                                                                            150
C****         ASSUME CORRECT NAMES FOR CLARITY.                              151
  400 HE = TIVAR(1)                                                          152
      PE = TIVAR(2)                                                          153
  410 S = 18.68-4.418E-3*HE + 3.945E-7*HE**2 + 1.146E-12*HE**3               154
     1-2.057E-15*HE**4 + 8.333E-20*HE**5                                     155
C****         TEST TO DETERMINE HOW  HW(AIR)  WILLBE COMPUTED.               156
  415 IF(TW.LE.3500.) GO TO 435                                              157
C****         HERE GET  HW(AIR)  FROM TABLE LOOK UP.                         158
      PEINAT = PE/2116.                                                      159
      CALL TABUP(HWTEMP,HWRTAB,T(II),AIR1,12,1)                              160
      CALL TABUP(HWPRES,HWRTAB,PEINAT,HWAIR,7,1)                             161
      GO TO 436                                                              162
C****         HERE GET  HW(AIR)  DIRECTLY.                                   163
  435 HWAIR = .26*TW                                                         164
  436 IF(TMELT(8))  460,437,460                                              165
  437 RNOSE = TMELT(6)                                                       166
      IF(TMELT(7))  440,450,440                                              167
C****         TEST TO SEE HOW  QBL  WILL BE COMPUTED.                        168
  440 CHLR = TIVAR(4)                                                        169
      GO TO 455                                                              170
C****         HERE COMPUTE  QBL  DIRECTLY BUT FIRST GET  CHLR.               171
  450 CALL CRATIO(TRAJV(18),CHLR)                                            172
  455 QBL = .037*(HE-HWAIR)*CHLR*TMELT(5)*SQRT(PE/2116.*1./RNOSE)            173
      GO TO 465                                                              174
C****         GET  QBL  FROM TIVAR(3) WHICH CAME FROM T-TABLE  3.            175
  460 QBL = TIVAR(3)                                                         176
  465 QSUB = QBL*S*2.4E6*(1./(PE/2116.)**.67)*EXP(-1.11E5/TW)                177
  475 QNET = QBL - QSUB - QRR                                                178
      QHGR = QBL                                                             179
      QC = QSUB                                                              180
C****         THAT ENDS THIS OPTION.                                         181
      GO TO 900                                                              182
C****              EFN 500 STARTS THE FIXED MELTING T OPTION.                183
C****              CHECK IN PTX1 FOR RHO*SPM TERM                            184
C****         QNET IN THIS OPTION IS DEFINED IN II.C.1.A                     185
  500 GO TO 100                                                              186
  600 CALL TABUP   (WARM,GASPR,TW,HCG,INDTL(4),3)                            187
      CALL TABUP (WARM,HTABL,TW,HEVAR,INDTL(4),1)                            188
C****          HTCONV(5) = SPM                                               189
  625 RTVAP = HTCONV(5)*HCG                                                  190
  650 DMDG =  DENSE(1)*HTCONV(5)                                             191
      QHGR = TIVAR(3)                                                        192
      QC = TIVAR(1)                                                          193
  655 HW = HEVAR(1)*TW                                                       194
      HRMHW = TIVAR(2) - HW                                                  195
  660 IF(GENRL(5)) 665,670,665                                               196
  665 QC = QC*HRMHW                                                          197
C****          PLACE DUMMY NUM. IN CHART(1) FOR SUB. QBLK.                   198
  670 CHART(1) = 1.0                                                         199
  675 CALL QBLK(QC,HRMHW,QBLOCK,DMDG)                                        200
C****          REMOVE DUMMY NUM. FROM CHART(1) MIGHT GET SCREWED OTHERWI     201
      CHART(1) = 0.0                                                         202
      QNET = QNET-RTVAP-QBLOCK                                               203
      GO TO 900                                                              204
C****    EFN 700 STARTS A COMBINATION GRAPHITE SUBLIMATION AND               205
C****    FIXED MELTING OPTION                                                206
  700 IF(TW-TMELT(3)) 200,200,500                                            207
  900 KT = KONVAR(2)+1                                                       208
      Q(KT,1) = QNET                                                         209
      Q(KT,2) = QRR                                                          210
      Q(KT,3) = QHGR                                                         211
      Q(KT,4) = QC                                                           212
      Q(KT,5) = QBLOCK                                                       213
  998 RETURN                                                                 214
      END                                                                    215
$IBFTC BEE
      SUBROUTINE BEE (II,NM,N,ITTEMP)                                          1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C************COMMON FOR VARIABLE T-P-D INPUT*******FOR BETA-4 TABLE****       62
      DIMENSION TMDENS(1),TMT(1),TMP(1),XFORT(1),XFORP(1),XFORDN(1)           63
C     ABOVE IS DUMMY DIMENSION -JUST TO ALLOW SUBSCRIBTING                    64
      EQUIVALENCE(TMDENS(1),DENS(301)),(TMT(1),T(301)),(TMP(1),P(301))        65
      EQUIVALENCE(XFORT(1),T(151)),(XFORP(1),P(151)),(XFORDN(1),DENS(151      66
     1))                                                                      67
      EQUIVALENCE(NT,T(449)),(NXT,T(450)),(NP,P(449)),(NXP,P(450))            68
      EQUIVALENCE(ND,DENS(449)),(NXD,DENS(450))                               69
C     THE T-P-AND DENS INPUTS ARE STORED IN THE                               70
C     LAST THIRD OF THEIR RESPECTIVE ARRAYS.                                  71
C     NT-NP-NDENS ETC ARE STORED IN LOC                                       72
C     NOT USED -DUE TO THE IMPOSSIBILITY OF HAVING 150 POINTS                 73
C     THE X TABLE FOR T(XFORT)ETC ARE STORED IN THE                           74
C     MIDDLE THIRD OF THEIR RESPECTIVE ARRAYS                                 75
C     FOR THE BETA 4 TABLE HAVING PSEUDO - VARIABLE DIMENSION                 76
      COMMON TXQTAB(200),NOFTS,NOFXS,NTXQ(50),ICON,JCON,END                   77
      DIMENSION     GVAR(6),XTEMP(150)                                        78
C****         THE BEE ROUTINE ASSUMES THAT THE CHARP SUBROUTINE HAS           79
C****         BEEN PREVIOSLY CALLED ,FOR THIS POINT TO BE COMPUTED.           80
C                              THIS SUBROUTINE CALCULATES                     81
C                              BETA(1-4) FOR THE DIFFERENCE                   82
C                              EQUATIONS.                                     83
C                              SET UP COUNTERS                                84
C****         COMPUTE THE BETA COEFFICIENTS IN CARTESIAN COODINATES.          85
      I = II                                                                  86
      MN = NM                                                                 87
      J = N                                                                   88
      TDN = 2. * DELETA(J)                                                    89
      NPTS = PTSIN(J) + 1.                                                    90
C                       TEST IF THIS IS A PRESSURE OPTION.                    91
      IF(KONVAR(7)-2) 2,1,2                                                   92
    1 CALL PBETA (I,MN,J,ITTEMP)                                              93
      GO TO 400                                                               94
C                              GET CORRECT TEMPERATURE,                       95
C                              DENSITY, AND PRESSURE.                         96
    2 TE = T(I)                                                               97
C             SET UP THE TRANSFORMATION TERMS.                                98
    8 IF(J-1) 10, 9, 10                                                       99
    9 DEN1 = DENS(I)                                                         100
      EX = ETASBX(MN)                                                        101
      EXX = ETAXX(MN)                                                        102
      ET = ETASBT(MN)                                                        103
      GO TO 201                                                              104
   10 DEN1 = DENSE(J)                                                        105
      EX = 1./THIKN(J)                                                       106
      EXX = 0.0                                                              107
      ET = 0.0                                                               108
C                              CALCULATE BETA(1-4)                           109
C                       TABLE LOOK-UP FOR CK,DK/DT,CP,                       110
  201 MN1 = (INDTL(4)+1)*(J-1)*3+1                                           111
      CALL TABUP(WARM,PROPT(MN1),TE,PROP,INDTL(4),-3)                        112
      SS = PROP(1)                                                           113
      CK = PROP(2)                                                           114
      DKDTUP = PROP(3)                                                       115
      BETA1 = CHARV(1)*CK/(DEN1*SS*CHARV(3))                                 116
      BETA2 = BETA1*DKDTUP/CK                                                117
      IF(J-1) 210, 206, 210                                                  118
  206 IF(CHART(1)) 214, 210, 214                                             119
  210 BETA3 = 0.0                                                            120
      BETA4 = 0.0                                                            121
      GO TO 249                                                              122
C****              THERE IS CHARRING SO BETA-S 3 AND 4                       123
C****                   HAVE VALUES.                                         124
  214 IF(MN-(JLAYER(J)+1)) 225, 230, 225                                     125
  225 IF(MN-(JLAYER(J) + NPTS + 1)) 239, 230, 239                            126
C****         COMPUTE THE DIFFERENCES FOR FRONT OR BACKFACES.                127
  230 CALL DFINTC(DENS,I,MN,J,RHON,SD)                                       128
      RHON = RHON/TDN                                                        129
      GO TO 247                                                              130
  239 RHON = (DENS(I+1) - DENS(I-1)) / TDN                                   131
  247 CALL TABUP(WARM,GASPR,TE,GVAR,INDTL(4),-5)                             132
      CG = GVAR(2)+GVAR(3)                                                   133
      BETA3 = BETA1*(CHARV(2)/CHARV(1)*EX*RHON+EMDG(MN)*CG/CHARV(1)/CK)      134
      GEE = GVAR(1)*WDOTP(MN)                                                135
      BETA4 = BETA1*GEE/CHARV(1)/CK                                          136
C****         SEE IF ANOTHER COORDINATE SYSTEM IS DESIRED.                   137
  249 IF(GENRL(9)) 250, 301, 260                                             138
C****         EFN 250 MODIFIES BETA(3,MN) FOR SPHERICAL COORDINATES.         139
  250 IF(GENRL(10)) 254, 252, 254                                            140
C****         Q TRAVELS IN NORMAL DIRECTION.                                 141
  252 CTRM = 2./ XLOC(MN)                                                    142
      GO TO 270                                                              143
C****         Q TRAVELS FROM INSIDE TO OUTSIDE.                              144
  254 CTRM = -2./ XLOC(MN)                                                   145
      GO TO 270                                                              146
C****         EFN 260 MODIFIES BETA(3,MN) FOR CYLINDRICAL COORDINATES.       147
  260 IF(GENRL(10)) 264, 262, 264                                            148
C****         Q TRAVELS IN NORMAL DIRECTION.                                 149
  262 CTRM = 1. / XLOC(MN)                                                   150
      GO TO 270                                                              151
C****         Q TRAVELS FROM INSIDE TO OUTSIDE.                              152
  264 CTRM = -1. / XLOC(MN)                                                  153
C****         NOW MODIFY BETA(3,MN).                                         154
  270 BETA3 = BETA3 - BETA1 * CTRM                                           155
C                              NOW COMPLETE BETA(1-4).                       156
  301 ETAXSQ = EX**2                                                         157
      BETA(1,MN) = BETA1*ETAXSQ                                              158
      BETA(2,MN) = BETA2*ETAXSQ                                              159
      BETA(3,MN) = BETA3*EX-ET+BETA1*EXX                                     160
      BETA(4,MN) = BETA4                                                     161
C                              TEST QUANTITIES TO CHECK                      162
C                              IF ITERATION IS NECESSARY                     163
C                              IN INTPTS                                     164
      IF (CHART(1)) 375,304,375                                              165
  304 IF (BETA2) 375,305,375                                                 166
  305 IF (ABS (WDOTP(MN))) 310,315,310                                       167
  310 IF (ABS(CG))  375,315,375                                              168
  315 NT1 = INDTL(4)+1                                                       169
      J1 = (J-1)*NT1*3+NT1                                                   170
      IF(ABS(PROPT(J1))) 375,380,375                                         171
  375 ITTEMP = 1                                                             172
C                       ITTEMP = 1 MEANS ITERATION IN MIDPTS.                173
      GO TO 400                                                              174
  380 ITTEMP = 0                                                             175
C                       ITTEMP = 0. MEANS NO ITERATION IN MIDPTS.            176
C     SEE IF B4 CORRECTION IS NEEDED FOR THIS RUN.                           177
  400 IF(NOFXS) 425,600,425                                                  178
C     B4 CORRECTION IS NEEDED SO BEGIN COMPUTATION AT 425                    179
C     IS THIS THE FIRST TIME STEP.                                           180
  425 IF (KONVAR(2).NE.1) GO TO 550                                          181
C     DOES THE FIRST TIME FALL BELOW THE TIME TABLE                          182
  430 IF (CTIME.GE.TXQTAB(1)) GO TO 440                                      183
  435 CALL ERROR(8,47HARG OUT OF RANGE TOO LOW ON TIME TABLE FOR B4  )       184
C     DOES THE FIRST XLOC FALL BELOW THE TABLE                               185
  440 NUMOFC = 1                                                             186
      C = XLOC(1)                                                            187
      NTNX = NOFTS + NOFXS                                                   188
      NPTOTL = KONVAR(1)                                                     189
  443 IF(C - TXQTAB(NTNX))  445,459,450                                      190
  445 IF (TXQTAB(NOFTS+1) -C)  459,459,446                                   191
  446 CALL ERROR(5,28HARG. OUT OF RANGE ON X TABLE)                          192
  450 IF(TXQTAB(NOFTS+1) -C)  446,459,459                                    193
  459 IF(NUMOFC .NE. 1)  GO TO 460                                           194
      C = XLOC(NPTOTL)                                                       195
      NUMOFC = 2                                                             196
      GO TO 443                                                              197
C     INITIALISE TIME TABLE REMEMBERING DEVICE                               198
  460 LTIME = 1                                                              199
  470 DO 490 JD = LTIME,NOFTS                                                200
C     USE LESS THAN BECAUSE TIME TABLE IS  ASCENDING                         201
  480 IF (CTIME.LT.TXQTAB(JD)) GO TO 510                                     202
  490 CONTINUE                                                               203
  500 CALL ERROR(7,42HARG OUT OF RANGE  TOO HIGH IN TIME FOR  B4)            204
C     AT 510 BEGIN TO WEIGHT TVALUES - GENERATE 1WAY TABLE IN XTCOMP.        205
  510 JTU = NOFTS+(JD  )*NOFXS                                               206
C     SAVE JD IN LTIME FOR NEXT TIME STEP.                                   207
      JTL = NOFTS+(JD-1)*NOFXS                                               208
      LTIME = JD                                                             209
C     GENERATE XTEMP FROM THE X-ARRAYS STARTING AT JXU AND JXL               210
C     FIRST FIND WEIGHTING FACTOR FROM TIME TABLE                            211
  525 TFACT = (CTIME - TXQTAB(JD-1))/(TXQTAB(JD) - TXQTAB(JD-1))             212
C     NOW WEIGHT ALL T VALUES.                                               213
  530 DO 535 JD = 1,NOFXS                                                    214
      JTUALT = JTU+JD                                                        215
      JTLALT = JTL+JD                                                        216
      XTEMP(JD) = TXQTAB(JTLALT)+(TXQTAB(JTUALT)-TXQTAB(JTLALT))*TFACT       217
  535 CONTINUE                                                               218
C     SET UP TIME SAVE TO DECIDE WHEN TO COMP. NEW T-RATIO.                  219
      TIMLST = CTIME                                                         220
      GO TO 560                                                              221
  550 IF (TIMLST.NE.CTIME) GO TO 470                                         222
      IF(GENRL(9))  555,552,555                                              223
  552 NTLST = NOFTS + JLAST                                                  224
      IF(XLOC(MN) .LT. TXQTAB(NTLST)) GO TO 565                              225
      GO TO 560                                                              226
C****         TABLE CAN BE ASCENDING OR DESCENDING IF CART. OR CYL.          227
  555 NTLST = NOFTS + JLAST                                                  228
      IF (XLOC(MN).GT. TXQTAB(NTLST))  GO TO 565                             229
  560 JLAST = 1                                                              230
C     START X SEARCH FROM WHEREVER YOU LEFT OFF LAST TIME.                   231
  565 DO 580 JD = JLAST,NOFXS                                                232
      JDNT = NOFTS + JD                                                      233
      IF (GENRL(9)) 576,577,576                                              234
  576 IF (GENRL(10)) 577,575,577                                             235
  575 IF (XLOC(MN).GT.TXQTAB(JDNT)) GO TO 585                                236
      GO TO 580                                                              237
  577 IF (XLOC(MN) .LT. TXQTAB(JDNT)) GO TO 585                              238
  580 CONTINUE                                                               239
C     AT 585 GENERATE B4 FROM JD AND JD-1                                    240
  585 B4ALT = XTEMP(JD-1) + ((XLOC(MN) - TXQTAB(JDNT  -1))/(TXQTAB(JDNT      241
     1  ) - TXQTAB(JDNT  -1)))*(XTEMP(JD)-XTEMP(JD-1))                       242
      B4ALT = B4ALT/(DEN1*SS*CHARV(3))                                       243
      JLAST = JD                                                             244
C     ADD CORRECTION TERM IN                                                 245
  590 BETA(4,MN)=BETA(4,MN)+B4ALT                                            246
  600 RETURN                                                                 247
      END                                                                    248
$IBFTC CHARP
      SUBROUTINE CHARP(II,J1)                                                  1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATIONS FOR THE CHARP ROUTINE ARE DISCUSSED AND           62
C****         DEFINED IN SECTION II.B.2( AND IN APPENDIX A                    63
C                       THIS SUBROUTINE CALCULATES THE                        64
C                              CHAR PROPERTIES K(A), K(A) PRIME,              65
C                              K BAR,AND CPA.                                 66
C                       CHAR TABLE ENTRIES.                                   67
C                       NON-PRESSURE DEPENDENT                                68
C****              CHART(1)  = CONTROL                                        69
C****                   1 MEANS NORMAL CHARRING OPTION.                       70
C****                   2 MEANS TRANSIENT PRESSURE OPTION.                    71
C****              CHART(2) = DENSITY OF CHAR                                 72
C****              CHART(3) = ORDER OF REACTION                               73
C****              CHART(4) = TIME TO CHANGE FROM LAMINAR TO                  74
C****                   TURBULENT OR VICE-VERSA.                              75
C****                   MINUS MEANS POWERED FLIGHT TRAJECTORY.                76
C****                   PLUS MEANS RE-ENTRY TRAJECTORY.                       77
C****              CHART(5) = PARAMETER FOR AK                                78
C****              CHART(6) = PARAMETER FOR AK                                79
C****              CHART(7) = PARAMETER FOR CPA                               80
C****              CHART(8) = PARAMETER FOR CPA                               81
C****              CHART(9) = CONSTANT FOR LAMINAR FLOW EQUATION              82
C****                   EQUATION.                                             83
C****              CHART(10) CONSTANT FOR LAMINAR FLOW IN QBLOCK              84
C****                   EQUATION.                                             85
C****              CHART(11) = CONSTANT FOR TURBULENT FLOW IN QBLOCK          86
C****                   EQUATION.                                             87
C****              CHART(12) CONSTANT FOR AMOUNT OF CHAR EQUATION.            88
      I = II                                                                  89
      J = J1                                                                  90
      HARD = DENS(I)                                                          91
      DENSC = CHART(2)                                                        92
      DDENS = HARD-DENSC                                                      93
      IF(CHART(1)) 1,11,1                                                     94
    1 IF (J-1) 21,21,11                                                       95
C                              PROPERTIES FOR ZERO SMAX AND                   96
C                              ALL LAYERS GREATER THAN 1.                     97
   11 AK = 1.                                                                 98
      CPA = 1.                                                                99
      AKP = 0.                                                               100
      GO TO 71                                                               101
C                              TEST FOR PRESSURE OPTION.                     102
   21 IF(KONVAR(7)-2) 31, 11, 31                                             103
   31 IF (DDENS) 51,41,51                                                    104
   41 AK = 1.-CHART(6)                                                       105
      CPA = 1.-CHART(8)                                                      106
      AKP = 0.                                                               107
      GO TO 71                                                               108
C                       COMPUTE (RHO-RHO(C))/(RHO(P)-RHO(C))                 109
C                       = DELRHO                                             110
   51 DELRHO = DDENS/(DENSE(J)-DENSC)                                        111
   54 AK = (1.-CHART(6))+CHART(6)*DELRHO**CHART(5)                           112
      CPA = (1.-CHART(8))+CHART(8)*DELRHO**CHART(7)                          113
      AKP = CHART(5)*(AK-1.+CHART(6))/DDENS                                  114
   71 CHARV(1) = AK                                                          115
      CHARV(2) = AKP                                                         116
      CHARV(3) = CPA                                                         117
   91 RETURN                                                                 118
      END                                                                    119
$IBFTC CLCINT
      FUNCTION CLCINT(IND,DARG,FARG,STOARG)                                    1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C                             INTEGRATION SUBROUTINE                          62
      DIMENSION STOARG(5)                                                     63
    1 DX=DARG                                                                 64
      FX=FARG                                                                 65
      IF(DX.NE.0.0) GO TO 41                                                  66
   21 STOARG(1)=0.0                                                           67
      GO TO 401                                                               68
   41 IF(IND.EQ.0) GO TO 101                                                  69
      IF(DX.EQ.STOARG(5)) GO TO 201                                           70
C     TRAPEZOIDAL RULE                                                        71
  101 STOARG(2)=DX/2.0*(FX+STOARG(3))                                         72
      GO TO 301                                                               73
C     SIMPSON,S RULE                                                          74
  201 STOARG(2)=DX/3.0*(FX+4.0*STOARG(3)+STOARG(4))-STOARG(2)                 75
  301 STOARG(1)=STOARG(1)+STOARG(2)                                           76
  401 CLCINT=STOARG(1)                                                        77
      STOARG(4)=STOARG(3)                                                     78
      STOARG(3)=FX                                                            79
      STOARG(5)=DX                                                            80
 5001 RETURN                                                                  81
      END                                                                     82
$IBFTC COORD
      SUBROUTINE COORD (NM,JAY)                                                1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      RZERO = 0.0                                                             62
C****         CHECK TO SEE IF COORDINATE SYSTEM OTHER THAN CARTESIAN          63
C****         IS TO BE USED.                                                  64
      IF(GENRL(9)) 4,270,4                                                    65
C****         COMPUTE THE SUM OF THE LAYER WIDTHES.                           66
    4 L = KONVAR(4)                                                           67
      IF(KONVAR(2) - 1) 5,5,250                                               68
    5 THIKLR = 0.0                                                            69
      DO 6 J = 2,L                                                            70
    6 THIKLR = THIKLR + THIKN(J)                                              71
C****         EFN 250 STARTS THE MODIFICATION OF THE XLOC(MN) FOR             72
C****              SPHERICAL OR CYLINDRICAL COORDINATES.                      73
  250 MN = NM                                                                 74
      IF( GENRL(10)) 254, 252, 254                                            75
C****         Q TRAVELS IN THE NORMAL DIRECTION                               76
  252 RZERO = ABS(GENRL(9)) + THIKN(1) + THIKLR + HTCONV(7)                   77
      XLOC(MN) = RZERO - XLOC(MN)                                             78
      GO TO 270                                                               79
C****         Q TRAVELS FROM THE INSIDE TO THE OUTSIDE WALL.                  80
  254 RZERO = ABS(GENRL(9))                                                   81
      XLOC(MN) = RZERO + XLOC(MN)                                             82
  270 TRAJV(50) = RZERO                                                       83
      RETURN                                                                  84
      END                                                                     85
$IBFTC CRATIO
      SUBROUTINE CRATIO                                                        1
C     THIS IS A DUMMY SUBROUTINE AND SHOULD NOT BE ENTERED                     2
      STOP                                                                     3
      END                                                                      4
$IBFTC DEE
      SUBROUTINE DEE(III,MNI)                                                  1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       62
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           63
     1             (TRAJV(21),TABLD)                                          64
C****             CHART TABLE FOR TRANSIENT PRESSURES.                        65
C****              CHART(1) = 2                                               66
C****              CHART(2) = DENSITY OF CHAR,RHO(C)                          67
C****              CHART(3) = ORDER OF REACTION.                              68
C****              CHART(4) =RE  TRIP TIME                                    69
C****              CHART(5) = EMISSIVITY-E(F)                                 70
C****              CHART(6) = GAMMA                                           71
C****              CHART(7) = N FOR K/E COMPUTATION                           72
C****              CHART(8) = RHO(C)-TILDA                                    73
C****              CHART(9) = MA/MC                                           74
C****              CHART(10) = PR                                             75
C****              CHART(11) = CT                                             76
C****              CHART(12) = DELTA                                          77
C****              CHART(13) = RHO - TILDA(P)                                 78
C****              COMPUTE THE EMISSIVITY AND STORE IN                        79
C****                TABLD(9).                                                80
      II = III                                                                81
      MN = MNI                                                                82
      JJ = II - KONVAR(1)                                                     83
      KT = KONVAR(2)                                                          84
      RCFP = CHART(8)*(1.-CHART(5))                                           85
      RCP = (RCFP+(CHART(6)-1.)*DENS(II))/CHART(6)                            86
      RPP = DENS(II)-RCP                                                      87
      TABLD(9) = 1.-RCP/CHART(8)-RPP/CHART(13)                                88
C****              COMPUTE THE DERIVATIVE OF EMMISSIVITY                      89
C****                WRT. ETA AND STORE IN TABLD(10).                         90
C****              LOGIC TO COMPUTE 3 POINT DIFFERENCES FOR FRONT             91
C****                   AND BACK FACES.                                       92
      NPTS = PTSIN(1) + 2.                                                    93
      IF(MN-1) 6,8,6                                                          94
    6 IF(MN-NPTS) 12, 10, 12                                                  95
    8 A = -3.                                                                 96
      B = 4.0                                                                 97
      C = -1.0                                                                98
      IP1 = II +2                                                             99
      IP2 = II                                                               100
      IP3 = II +1                                                            101
      GO TO 11                                                               102
   10 A = 3.                                                                 103
      B = -4.0                                                               104
      C = 1.0                                                                105
      EMM = 1.-RCP/CHART(8)-RPP/CHART(13)                                    106
      CALL TABUP(HORA,TTABL,CTIME,TIVAR(4),INDTL(5),4)                       107
      P(II) = EMM*TIVAR(4)*GRAPH(9)/GRAPH(8)/T(II)                           108
      IP1 = II-2                                                             109
      IP2 = II                                                               110
      IP3 = II-1                                                             111
   11 JP1 = IP1 - KONVAR(1)                                                  112
      JP2 = IP2 - KONVAR(1)                                                  113
      JP3 = IP3 - KONVAR(1)                                                  114
      TRHON = A * DENS(IP2) + B * DENS(IP3) + C * DENS(IP1)                  115
      TPORJ = A * DENS(JP2) + B * DENS(JP3) + C * DENS(JP1)                  116
      TPORI = TRHON                                                          117
      TRHONN = DENS(IP1) + DENS(IP2) - 2. * DENS(IP3)                        118
      RHON = TRHON/2./DELETA(1)                                              119
      RHONN = TRHONN/DELETA(1)**2                                            120
      TPORS = TPORI - TPORJ                                                  121
      GO TO 14                                                               122
   12 RHON = (DENS(II+1)-DENS(II-1))/2./DELETA(1)                            123
      RHONN = (DENS(II+1)+DENS(II-1)-2.*DENS(II))/DELETA(1)**2               124
      TPORS = DENS(II+1)-DENS(II-1) -DENS(JJ+1) + DENS(JJ-1)                 125
   14 TEMETA = -((CHART(6)-1.)/CHART(8)+1./CHART(13))/CHART(6)               126
      TABLD(10) = TEMETA*RHON                                                127
C****              COMPUTE THE 2ND DERIV. OF EMISSIVITY                      128
C****                WRT. ETA AND STORE IN TABLD(11).                        129
      TABLD(11) = TEMETA*RHONN                                               130
C****              COMPUTE D(1-4) AND STORE IN TABLD(1-4)                    131
C****              CALL KFS FOR K(F),K(F)-ETA/K(F),                          132
C****                K(F)-ETA-ETA/K(F),K(F)-T/K(F),WHICH ARE                 133
C****                STORED IN SCDTB(12-15) INC.                             134
      CALL KFS(II,MN)                                                        135
      EN1 = CHART(7)-1.                                                      136
      CAYDE = TABLD(9)**CHART(7)*SCDTB(12)                                   137
      TRM2 = (SCDTB(14)-SCDTB(13)**2)*CAYDE                                  138
   15 IF(CHART(7)) 30, 20, 30                                                139
   20 CAYDEN = CAYDE * SCDTB(13)                                             140
      TRM1 = CAYDEN*SCDTB(13)                                                141
      CAYENN = TRM1 + TRM2                                                   142
      GO TO 60                                                               143
   30 IF(CHART(7)-1.) 15, 35, 55                                             144
   35 CAYDEN = CAYDE*SCDTB(13)+CHART(7)*TABLD(9)**EN1*SCDTB(12)*             145
     1TABLD(10)                                                              146
      TRM1 = CAYDEN*SCDTB(13)                                                147
      TRM4 = CHART(7)*TABLD(9)**EN1*(TABLD(10)*SCDTB(13)*SCDTB(12)+          148
     1SCDTB(12)*TABLD(11))                                                   149
      CAYENN = TRM1 + TRM2 + TRM4                                            150
      GO TO 60                                                               151
   55 CAYDEN = CAYDE*SCDTB(13)+CHART(7)*TABLD(9)**EN1*SCDTB(12)*             152
     1TABLD(10)                                                              153
      TRM1 = CAYDEN*SCDTB(13)                                                154
      TRM3 = CHART(7)*EN1*TABLD(9)**(EN1-1.)*SCDTB(12)*TABLD(10)**2          155
      TRM4 = CHART(7)*TABLD(9)**EN1*(TABLD(10)*SCDTB(13)*SCDTB(12)+          156
     1SCDTB(12)*TABLD(11))                                                   157
      CAYENN = TRM1+TRM2+TRM3+TRM4                                           158
   60 TABLD(4) = -WDOTP(MN)                                                  159
      TABLD(12) = TEMATA * TPORS /2./ DELETA(1) / DELTO(KT)                  160
      TABLD(13) = TEMETA * (DENS(II)-DENS(JJ))/DELTO(KT)                     161
C****              D(1)-T IS STORED IN TABLD(8).                             162
      TABLD(18) = CHART(7)*TABLD(9)**EN1*TABLD(13)*SCDTB(12)+                163
     1TABLD(9)**CHART(7)*SCDTB(15)*SCDTB(12)                                 164
      TABLD(14) = RCFP                                                       165
      TABLD(15) = CAYDE                                                      166
      TABLD(16) = CAYDEN                                                     167
      TRM1NT = TABLD(18)*SCDTB(13)                                           168
      TRM2NT = TABLD(15)*SCDTB(16)                                           169
      TRM3NT =CHART(7)*EN1*TABLD(9)**(EN1-1.)*SCDTB(12)*TABLD(12)            170
      TRM4NT = CHART(7)*TABLD(9)**EN1*TABLD(10)*SCDTB(15)*SCDTB(12)          171
      TABLD(17) = TRM1NT + TRM2NT + TRM3NT + TRM4NT                          172
      TABLD(19) = CAYENN                                                     173
C****              FIRST CALL PHI FOR PHI(1),PHI(1)-ETA,                     174
C****                PHI(1)-ETA-ETA,PHI(1)-T,WHICH ARE                       175
C****                STORED IN SCDTB(6-10) INC.                              176
      CALL PHI(II,MN)                                                        177
      TABLD(1) = SCDTB(6)*CAYDE                                              178
      D1N = SCDTB(7)*CAYDE + SCDTB(6)*CAYDEN                                 179
      D1NN = SCDTB(8)*CAYDE +2.*SCDTB(7)*CAYDEN+SCDTB(6)*CAYENN              180
      TABLD(2) = 3.*ETASBX(MN)*D1N                                           181
      TABLD(3) = D1NN*ETASBX(MN)**2+D1N*ETAXX(MN)                            182
      TABLD(5) = D1N                                                         183
      TABLD(6) = D1NN                                                        184
      TABLD(8) = SCDTB(10)*CAYDE + SCDTB(6)*TABLD(18)                        185
      TD1NT1 = SCDTB(9)*TABLD(15)                                            186
      TD1NT2 = SCDTB(7)*TABLD(18)                                            187
      TD1NT3 = SCDTB(10)*TABLD(16)                                           188
      TD1NT4 = SCDTB(6)*TABLD(17)                                            189
      D1NT = TD1NT1 + TD1NT2 + TD1NT3 + TD1NT4                               190
      TABLD(7) = D1NT                                                        191
  201 RETURN                                                                 192
      END                                                                    193
$IBFTC DENSIT
      SUBROUTINE DENSIT(ISTR,M,K)                                              1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION DBAR(1),CBAR(1)                                               62
      DIMENSION AI(150),BI(150),CI(150),DI(150)                               63
      EQUIVALENCE  (DBAR,DI) , (CBAR,CI)                                      64
C****       THE EQUATIONS IN THIS SUBROUTINE ARE DISCUSSED IN SECTION V       65
C                       I OR II, MEANS POINT WRT. TIME-STEP.                  66
C                       M OR MN, MEANS POINT WRT. POSITION.                   67
      II = ISTR                                                               68
      KT = KONVAR(2)                                                          69
      DT = DELTO(KT)                                                          70
      MN = M                                                                  71
C                       K = ZERO, MEANS USE IMPLICIT SCHEME.                  72
C                       K = 1, MEANS USE EXPLICIT SCHEME.                     73
      KAY = K                                                                 74
      NPTS = PTSIN(1)+2.                                                      75
      IT = KONVAR(1)                                                          76
      JJ = II - IT                                                            77
      KNG = KONVAR(6)                                                         78
      IF(CHART(1)) 5,60,5                                                     79
    5 IF (IMEX) 100, 7,14                                                     80
    7 IF (KAY) 30,30,10                                                       81
C                       EXPLICIT SCHEME STARTS AT STATEMENT 10.               82
   10 IF (CHART(1)) 11,60,11                                                  83
   11 IF(KT-1) 12, 14, 12                                                     84
   12 DTR = DT/DELTO(KT-1)                                                    85
      DO 13 I = 1,NPTS                                                        86
      II = 2*IT + I                                                           87
      JJ = II-IT                                                              88
C****         DENS(II) IS DEFINED IN EQUATION V.14                            89
      DENS(II) = (DTR+1.)*DENS(JJ)-DTR*DENS(I)                                90
      IF(DENS(II)-CHART(2)*1.000001) 113, 113, 114                            91
  113 DENS(II) = CHART(2)                                                     92
      GO TO 13                                                                93
  114 IF(ABS(DENS(II)-DENS(JJ))-ABS(DENS(JJ)*1.E-6)) 115,13,13                94
  115 DENS(II) = DENS(JJ)                                                     95
   13 CONTINUE                                                                96
      GO TO 500                                                               97
   14 DO 27 N = 1,NPTS                                                        98
      II = KONVAR(1)*KONVAR(6) +N                                             99
      JJ = II-KONVAR(1)                                                      100
      MN = N                                                                 101
      WDPMN = WDOTP(MN)                                                      102
      ETATMN = ETASBT(MN)                                                    103
      IF (ETATMN) 15,20,20                                                   104
   15 DELRHO = DENS(JJ+1)-DENS(JJ)                                           105
      GO TO 21                                                               106
   20 DELRHO = DENS(JJ)-DENS(JJ-1)                                           107
C****         DENS(II) IS DEFINED IN EQUATION V.10                           108
   21 DENS(II) = DENS(JJ)+DT*(WDPMN-ETATMN*DELRHO/DELETA(1))                 109
      IF(DENS(II)-CHART(2)*1.000001) 23, 23, 24                              110
   23 DENS(II) = CHART(2)                                                    111
      GO TO 27                                                               112
   24 IF(ABS(DENS(II)-DENS(JJ))-ABS(DENS(JJ)*1.E-6)) 25, 27, 27              113
   25 DENS(II) = DENS(JJ)                                                    114
   27 CONTINUE                                                               115
      GO TO 500                                                              116
C                       IMPLICIT SCHEME STARTS AT STATEMENT 30.              117
   30 D = DENS(II)                                                           118
      EPS = -EPTAB(7)                                                        119
      ETATMN = ETASBT(MN)                                                    120
   33 CALL WDP(II,MN)                                                        121
      WDPMN = WDOTP(MN)                                                      122
      IF (ETATMN) 36,35,35                                                   123
   35 RHOB = DENS(II-1)                                                      124
      GO TO 37                                                               125
   36 RHOB = DENS(II+1)                                                      126
   37 ALPHA = ABS(DT*ETATMN/DELETA(1))                                       127
C****         DENS(II) IS DEFINED IN EQUATION V.11                           128
      DENS(II) = (DENS(JJ)+DT*WDPMN+ALPHA*RHOB)/(1.+ALPHA)                   129
      IF(DENS(II)-CHART(2)*1.000001) 40, 40, 45                              130
   40 DENS(II) = CHART(2)                                                    131
      GO TO 50                                                               132
   45 IF(ABS(DENS(II)-DENS(JJ))-ABS(DENS(JJ)*1.E-6)) 46, 50, 50              133
   46 DENS(II) = DENS(JJ)                                                    134
   50 CALL TNEST(DENS(II),D,EPS)                                             135
      EPS = ABS(EPS)                                                         136
      COUNT(11) = COUNT(11) + 1.                                             137
      KD = D                                                                 138
C                       D IS CHANGED IN TNEST( 0.= NO CONV.,                 139
C                       NON-ZERO = CONVERGENCE).                             140
      GO TO (500,33,55),KD                                                   141
   55 WRITE(6,550)   ALPHA,RHOB,WDPMN,DENS(II)                               142
      GO TO 33                                                               143
C                       COMPUTATIONS FOR CONSTANT DENSITY.                   144
   60 NPSI = KONVAR(1)                                                       145
      DO 65 L = 1,NPSI                                                       146
      II = KONVAR(6)*KONVAR(1)+L                                             147
      JJ = II - KONVAR(1)                                                    148
   65 DENS(II) = DENS(JJ)                                                    149
      GO TO 500                                                              150
C****          AT 100 THE STRICTLY IMPLICIT SCHEME HAS BEEN REQUESTED.       151
  100 IF(ETASBT(1) )  105,105,103                                            152
  103 CALL ERROR (6,33HA(1) NOT ZERO CAN'T START SCHEME.)                    153
  105 RZERO = DELTO(KTIME)/DELETA(1)*ETASBT(MN)                              154
      DO 150 MN = 1,NPTS                                                     155
      JJ = (KNG-1)*IT +MN                                                    156
      II = JJ + IT                                                           157
      IF (ETASBT(MN))  110,120,120                                           158
  110 ALPHA = 1.                                                             159
      GO TO 125                                                              160
  120 ALPHA = 0.0                                                            161
  125 IF(KT-1) 130,135,130                                                   162
  130 DTR = DT/DELTO(KT-1)                                                   163
      GO TO 140                                                              164
  135 DTR = 0.0                                                              165
  140 DENS(II) = (DTR+1.)*DENS(JJ) - DTR*DENS(MN)                            166
      CALL WDP(II,MN)                                                        167
      AI(MN) = RZERO*(ALPHA-1.)                                              168
      BI(MN) = 1.+ ABS(RZERO)                                                169
      CI(MN) = RZERO*ALPHA                                                   170
      DI(MN) = DELTO(KTIME)*WDOTP(MN) + DENS(JJ)                             171
C****          COMPUTE INTERMEDIATE VALUES.                                  172
      CBAR(MN) = CI(MN)/(BI(MN) -CBAR(MN-1)*AI(MN))                          173
      DBAR(MN) = (DI(MN)-DBAR(MN-1)*AI(MN))/(BI(MN)-CBAR(MN-1)*AI(MN))       174
  150 CONTINUE                                                               175
C****          NOW COMPUTE THE DENSITIES COMPLETELY IMPLICITLY'''            176
C****          DO THE BOUNDARY LAYER FIRST.                                  177
      NBNLYR = (KNG+1)*IT                                                    178
  160 DENS(NBNLYR) = DBAR(NPTS)                                              179
      NPTS1 = NPTS -1                                                        180
      DO 200 I = 1,NPTS1                                                     181
      MN = NPTS - I                                                          182
      II = KNG*IT + MN                                                       183
      DENS(II) = DBAR(MN) -CBAR(MN)*DENS(II+1)                               184
  200 CONTINUE                                                               185
  500 RETURN                                                                 186
  550 FORMAT (1H0,3X,8HALPHA = E18.8,3X,7HRHOB = E18.8,3X,6HWDP = E18.8,     187
     13X,8HRHO-I = E18.8)                                                    188
      STOP                                                                   189
      END                                                                    190
$IBFTC DEPOLY
      SUBROUTINE DEPOLY                                                        1
C     THIS IS A DUMMY SUBROUTINE AND SHOULD NOT BE ENTERED                     2
      STOP                                                                     3
      END                                                                      4
$IBFTC DFINTC
      SUBROUTINE DFINTC (DFFC, III, MNI, JL, FD, SD)                           1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION DFFC(1)                                                       62
      MN = MNI                                                                63
      J = JL                                                                  64
      II = III                                                                65
      NPT = PTSIN(J) + 2.                                                     66
      NPTS=JLAYER(J) +NPT                                                     67
      IF(MN-1) 5,10,5                                                         68
    5 IF(MN-NPTS) 20, 15, 20                                                  69
   10 FDI = -3.*DFFC(II) + 4.*DFFC(II+1) - DFFC(II+2)                         70
      SDI = DFFC(II+2) + DFFC(II) -2.*DFFC(II+1)                              71
      GO TO 30                                                                72
   15 FDI = 3.*DFFC(II) - 4.* DFFC(II-1) + DFFC(II-2)                         73
      SDI = DFFC(II-2) + DFFC(II) -2.*DFFC(II-1)                              74
      GO TO 30                                                                75
   20 FDI = DFFC(II+1) - DFFC(II-1)                                           76
      SDI = DFFC(II+1) + DFFC(II-1) - 2.*DFFC(II)                             77
   30 FD = FDI                                                                78
      SD = SDI                                                                79
  100 RETURN                                                                  80
      END                                                                     81
$IBFTC DPRESS
      SUBROUTINE DPRESS                                                        1
     1             (III,                                                       2
C****              WHERE III MEANS THE SUBSCRIPT OF THE POINT                  3
C****                   TO BE COMPUTED.                                        4
     2             MN1,                                                        5
C****              SUBSCRIPT RELATED TO III, BUT FOR ONLY                      6
C****                   ONE TIME STEP.                                         7
     3             IMP)                                                        8
C****              ONE MEANS EXPLICIT POINTS ARE TO BE                         9
C****                   CALCULATED.                                           10
C****              ZERO MEANS IMPLICIT POINTS ARE TO BE                       11
C****                   CALCULATED.                                           12
C****              - 1 MEANS, THE ROUTINE WAS CALLED FROM STARTT.             13
C****                         INPUT     COMMON                                14
                                                                              15
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                 16
     1                   ZORET( 84)                                           17
                                                                              18
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),             19
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,             20
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,             21
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             22
     4                  NWARM      ,   NZORET(  4)                            23
                                                                              24
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            25
                                                                              26
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             27
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             28
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              29
                                                                              30
      COMMON  /INPTC /   PVAR ( 50)                                           31
                                                                              32
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             33
     1                  WARM ( 20)                                            34
                                                                              35
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            36
                                                                              37
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             38
     1                  DGREE( 20),    E     (150),   EP   (150),             39
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             40
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            41
     4                  STVAR ( 25)                                           42
                                                                              43
                                                                              44
C****                              COMPUTATION COMMON                         45
                                                                              46
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            47
                                                                              48
      COMMON  /COUNTR/   COUNT ( 25)                                          49
                                                                              50
      COMMON  /HEATDP/   Q    (4,13)                                          51
                                                                              52
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            53
                                                                              54
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            55
                                                                              56
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            57
                                                                              58
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             59
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             60
     2                  P      (450),  T     (450),   WDOTP(150),             61
     3                  XLOC  (150)                                           62
                                                                              63
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  64
                                                                              65
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           66
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             67
                                                                              68
      COMMON  /OUTDPT/  AUS(25)                                               69
                                                                              70
      COMMON  /HEADG /  HEAD(14)                                              71
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         72
                                                                              73
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       74
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           75
     1             (TRAJV(21),TABLD)                                          76
      IM = IMP                                                                77
      II = III                                                                78
      MN = MN1                                                                79
      JJ = II - KONVAR(1)                                                     80
      CTIME = CTIME                                                           81
      NPTS = PTSIN(1)+2.                                                      82
      KT = KONVAR(2)                                                          83
      IF(IM) 200, 300, 10                                                     84
   10 IF (KT-1) 60,15,60                                                      85
C****              EFN 10 STARTS THE EXPLICIT SCHEME                          86
   15 NPTS = NPTS - 2                                                         87
      TIVAR(9) = 0.0                                                          88
      TIVAR(10) = 0.0                                                         89
      NPTS1 = NPTS +1                                                         90
      KN = 1                                                                  91
      KM = 0                                                                  92
      ITIME = KONVAR(1)                                                       93
      P(ITIME+1) = P(1)                                                       94
      DO 50 IR = 2,NPTS1                                                      95
      II = KONVAR(6) *KONVAR(1) + IR                                          96
      JJ = II-KONVAR(1)                                                       97
      MN = IR                                                                 98
C****              COMPUTE THE D VARIABLES FOR EACH POINT.                    99
      CALL DEE(JJ,MN)                                                        100
      DTN = DELTO(KT)/DELETA(1)                                              101
      RZ = DTN/2.                                                            102
      B1 = TABLD(1)*ETASBX(MN)**2                                            103
      R1 = DTN/DELETA(1) *B1                                                 104
      R2 = P(JJ+1)+P(JJ-1)                                                   105
      R3 = P(JJ+1)-P(JJ-1)                                                   106
      TRM = R1*R2                                                            107
      TRM1 = RZ*R3                                                           108
      RN = R3/2./DELETA(1)                                                   109
      B2 = TABLD(2)*ETASBX(MN)+TABLD(1)*ETAXX(MN)                            110
      B3 = B1*RN                                                             111
      B4 = B3-ETASBT(MN)                                                     112
      TRM3 = (TABLD(3)*DELTO(KT) - 2.*R1)*P(JJ)                              113
      P(II) = P(JJ)*(1.+TRM+B2*TRM1+TRM3)+B4*TRM1+DELTO(KT)*TABLD(4)         114
   50 CONTINUE                                                               115
      KEND = NPTS +2 +KONVAR(1)                                              116
   51 P(KEND) = P(NPTS+2)                                                    117
      GO TO 400                                                              118
C****              EFN 60 STARTS EXPLICIT SCHEME AFTER 1ST TIME STEP.        119
   60 DTR = DELTO(KT)/DELTO(KT-1)                                            120
      DO 100 IR = 1,NPTS                                                     121
      II = 2*KONVAR(1) + IR                                                  122
      JJ = II - KONVAR(1)                                                    123
      P(II) = (DTR+1.)*P(JJ)-DTR*P(IR)                                       124
  100 CONTINUE                                                               125
      GO TO 400                                                              126
C****              COMPUTE THE FRONT FACE DENSITY, AND THEN                  127
C****                   SET ALL THE DENSITIES EQUAL TO IT.                   128
  200 CALL RHOFFC(1,1,-1)                                                    129
      DO  250 IR = 1,NPTS                                                    130
      P(IR) = P(1)                                                           131
  250 CONTINUE                                                               132
      GO TO 400                                                              133
C****              EFN 300 STARTS THE IMPLICIT SCHEME.                       134
  300 CALL DEE(II,MN)                                                        135
      IF(MN-1) 310, 312, 310                                                 136
  310 IF(MN-NPTS) 315, 313, 315                                              137
  312 NI = 0                                                                 138
      GO TO 314                                                              139
  313 NI = 1                                                                 140
  314 CALL RHOFFC(II,MN,NI)                                                  141
      GO TO 400                                                              142
  315 B1 = TABLD(1)*ETASBX(MN)**2                                            143
      B2 = TABLD(2)*ETASBX(MN)+TABLD(1)*ETAXX(MN)                            144
      B3 = B1*(P(II+1)-P(II-1))/2./DELETA(1)                                 145
      B4 = B3 - ETASBT(MN)                                                   146
      Q(KT,8) = AMAX1(Q(KT,8),B2)                                            147
      Q(KT,9) = AMAX1(Q(KT,9),B4)                                            148
      DTN = DELTO(KT)/DELETA(1)                                              149
      RZ = DTN/DELETA(1)                                                     150
      R1 = DTN                                                               151
      DNB2 = DELETA(1) * B2                                                  152
      IF(B2) 318, 318, 320                                                   153
  318 A1 = 0.0                                                               154
      GO TO 322                                                              155
  320 A1 = 1.0                                                               156
  322 IF(B4) 324, 324, 326                                                   157
  324 A2 = 0.0                                                               158
      GO TO 328                                                              159
  326 A2 = 1.0                                                               160
  328 G1 = RZ*(B1 + A1*DNB2)                                                 161
      G2 = RZ*(B1 + (A1 - 1.0)*DNB2)                                         162
      G3 = R1 * B4 * A2                                                      163
      G4 = R1 * B4*  ( A2 - 1.0)                                             164
      A = G1 + G2 -TABLD(3) * DELTO(KT)                                      165
      B = 1.0 + G3 + G4 - G1 * P(II+1) - G2 * P(II-1)                        166
      C = G3*P(II+1) + G4*P(II-1) + P(JJ) + TABLD(4)*DELTO(KT)               167
      D = 4.*A*C/(B**2)                                                      168
      IF(A) 390,340,340                                                      169
  340 IF(C) 390, 342, 342                                                    170
  342 IF(B) 350, 360, 352                                                    171
  350 A3 = 1.0                                                               172
      GO TO 360                                                              173
  352 A3 = -1.0                                                              174
  356 IF(.02-D) 360, 358, 358                                                175
  358 IF(1.E-8-ABS(D)) 1358, 359, 359                                        176
 1358 TRM = -D/2.0*(1.0 -D/4.0 +D**2/8.-.078125*D**3)                        177
      GO TO 362                                                              178
  359 TRM = -D/2.                                                            179
      GO TO 362                                                              180
  360 TRM = 1.0 + A3*SQRT(1.+D)                                              181
  362 P(II) = -B/2./A*TRM                                                    182
      GO TO 400                                                              183
  390 CALL ERROR(3,16H A OR C IS MINUS  )                                    184
  400 RETURN                                                                 185
      END                                                                    186
$IBFTC EMG
      SUBROUTINE EMG(II)                                                       1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATION FOR THE MASS FLUX OF THE GAS, M-DOT-G,             62
C****         IS DEFINED IN SECTION II.B.2                                    63
      K2 = II                                                                 64
      IF(KONVAR(7)-2) 1,121,1                                                 65
    1 K1 = KONVAR(6)*KONVAR(1)                                                66
      NPTS = PTSIN(1)+1.                                                      67
      EMDG(NPTS+1) = 0.                                                       68
      IF (K2) 3,11,3                                                          69
    3 NPTS = 1                                                                70
      K = K2-K1                                                               71
      GO TO 21                                                                72
   11 K = 1                                                                   73
   21 DO 107 I1 = 1,NPTS                                                      74
      N = (NPTS-I1+1)*K                                                       75
      I = N+K1                                                                76
      IF(N) 45, 45, 55                                                        77
   45 N = I                                                                   78
   55 CALL WDP(I,N)                                                           79
C****              USING TRAPEZOIDAL RULE, SOLVE FOR                          80
C****                   M-DOT-G OF EACH POINT.                                81
      IF(GENRL(9)) 65, 60, 75                                                 82
C****         EFN 60 COMPUTES EMDG(N) FOR CARTESIAN COORDINATES.              83
   60 EMDG(N) = EMDG(N+1)-.5*DELETA(1)*(WDOTP(N)/ETASBX(N)+WDOTP(N+1)/ET      84
     1ASBX(N+1))                                                              85
      GO TO 107                                                               86
C****         EFN 65 COMPUTES EMDG(N) FOR SPHERICAL COORDINATES.              87
   65 CALL ERROR(9,54H  OPTION FOR EMDG SPERICAL COORDINATES NOT DETERMI      88
     1NED  )                                                                  89
   75 DRS1 = XLOC(N)                                                          90
      DRS2 = XLOC(N+1)                                                        91
   85 EMDG(N) = EMDG(N+1) - .5*DELETA(1)/TRAJV(50)    *(WDOTP(N)*DRS1/        92
     1 ETASBX(N) + WDOTP(N+1) * DRS2/ETASBX(N+1))                             93
  107 CONTINUE                                                                94
      GO TO 200                                                               95
  121 CALL PEMDG(K2)                                                          96
  200 RETURN                                                                  97
      END                                                                     98
$IBFTC ERROR
      SUBROUTINE ERROR(N,A)                                                    1
      DIMENSION A(10)                                                          2
      WRITE (6,1) (A(I),I=1,N)                                                 3
    1 FORMAT (1HK,10A6)                                                        4
C     TO GET A SUBROUTINE BACK TRACE WE DO THIS                                5
      X = SQRT(-1.0)                                                           6
      STOP                                                                     7
      END                                                                      8
$IBFTC EXEC2
      SUBROUTINE EXEC2                                                         1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C************COMMON FOR VARIABLE T-P-D INPUT*******FOR BETA-4 TABLE****       62
      DIMENSION TMDENS(1),TMT(1),TMP(1),XFORT(1),XFORP(1),XFORDN(1)           63
C     ABOVE IS DUMMY DIMENSION -JUST TO ALLOW SUBSCRIBTING                    64
      EQUIVALENCE(TMDENS(1),DENS(301)),(TMT(1),T(301)),(TMP(1),P(301))        65
      EQUIVALENCE(XFORT(1),T(151)),(XFORP(1),P(151)),(XFORDN(1),DENS(151      66
     1))                                                                      67
      EQUIVALENCE(NT,T(449)),(NXT,T(450)),(NP,P(449)),(NXP,P(450))            68
      EQUIVALENCE(ND,DENS(449)),(NXD,DENS(450))                               69
C     THE T-P-AND DENS INPUTS ARE STORED IN THE                               70
C     LAST THIRD OF THEIR RESPECTIVE ARRAYS.                                  71
                                                                              72
C     NT-NP-NDENS ETC ARE STORED IN LOC                                       73
C     NOT USED -DUE TO THE IMPOSSIBILITY OF HAVING 150 POINTS                 74
C     THE X TABLE FOR T(XFORT)ETC ARE STORED IN THE                           75
C     MIDDLE THIRD OF THEIR RESPECTIVE ARRAYS                                 76
C     FOR THE BETA 4 TABLE HAVING PSEUDO - VARIABLE DIMENSION                 77
      COMMON TXQTAB(200),NOFTS,NOFXS,NTXQ(50),ICON,JCON,END                   78
      COMMON MK                                                               79
      DIMENSION TABLN(120)                                                    80
   18 GO TO (19,69),JCON                                                      81
   19 CALL DELTAT(0)                                                          82
      ZERO = 0.0                                                              83
C****              MAKE SURE TNEST IS CLEARED.                                84
      CALL TNEST(ZERO,ZERO,ZERO)                                              85
      KT = KONVAR(2)                                                          86
      CALL GAMA(-DELTO(KT))                                                   87
C                       CHECK NZERO TO SEE                                    88
C                       WHICH POINT TO START THE                              89
C                       EXPLICIT EQUATION.                                    90
      NZERO1 = 5 - KONVAR(3)                                                  91
C                       CHECK IF PAST THE STOP TIME,                          92
C                       IF NOT, CALCULATE THE TIME FOR                        93
C                       THE TIME STEP.                                        94
      IF(IMEX.EQ.-1.AND.CHART(1).NE.0.0)  CALL TMPIMP(-1)                     95
      IF(CTIME+DELTO(KT) - GENRL(2)) 22, 75, 75                               96
   22 CTIME = CTIME + DELTO(KT)                                               97
C                       DELTA T IS STORED IN DELTO(KTIME)                     98
      NPTS = PTSIN(1)                                                         99
      IF(NPTS-1) 24, 23, 24                                                  100
C                  THIN SKIN COMPUTATIONS.                                   101
   23 CALL PTX12                                                             102
      GO TO 69                                                               103
C                  CALCULATE THE DENSITIES EXPLICITLY.                       104
   24 IF(IMEX.EQ.-1)  GO TO 30                                               105
      CALL DENSIT(1,1,1)                                                     106
      IF(KONVAR(7)-2) 26, 25, 26                                             107
C                  PRESSURE COMPUTATIONS.                                    108
   25 CALL PRESSM(0,0,0,1)                                                   109
C                       CALCULATE THE TEMPERATURES                           110
C                       OF THE INTERIOR POINTS BY                            111
C                       USING THE EXPLICIT SCHEME.                           112
   26 CALL INTPTS(0,NZERO1)                                                  113
C                       SET UP SPACING FOR TIME STEP                         114
C                       BEING COMPUTED.                                      115
C****              COMPUTE ONLY R VALUES                                     116
   30 CALL RITER(2)                                                          117
C                       COMPUTE THE AMOUNT MELTED                            118
C                       AND CHARRED.                                         119
   35 CALL ABLATE (DELTO(KT))                                                120
C****              COMPUTE ETA DERIVATIVES AND X LOCATIONS.                  121
      CALL RITER(3)                                                          122
C****         M-DOT-G NEEDS TO BE COMPUTED IF THERE IS CHARRING              123
      IF(CHART(1)) 40, 50, 40                                                124
   40 CONTINUE                                                               125
      CALL EMG(0)                                                            126
C                       COMPUTE THE RATE OF MELTING                          127
C                       AND CHARRING.                                        128
   50 CALL ABLATE(0)                                                         129
C                       SET UP CONSTANTS FOR ITERATION                       130
      EP = -ABS(EPTAB(6))                                                    131
      RMELT = HTCONV(5)                                                      132
      RMELT1 = RMELT                                                         133
C                       COMPUTE DELTA T FOR ITERATION                        134
C                       DEPENDING ON KD.                                     135
      KD = -1                                                                136
      CALL DELTAT(KD)                                                        137
      IF(KD) 54, 53, 53                                                      138
   53 CALL GAMA(-DELTO(KT))                                                  139
      GO TO 24                                                               140
C****                   COMPUTE THE ETA(T)-S.                                141
   54 CALL NSUBT                                                             142
      IF (IMEX) 249,249,276                                                  143
  249 IF (ABS(RMELT1*ETASBX(1))-.001) 275,275,250                            144
  250 IF(EPTAB(6))  254,275,275                                              145
C                  SECTION FOR ITERATION ON EXPLICIT POINTS ONLY,            146
C                       DUE TO RATE OF MELT.                                 147
  254 IF(KONVAR(3) -3) 260,256,260                                           148
  256 N4 = PTSIN(1)                                                          149
      CALL INTPTS(1,N4)                                                      150
  260 CALL PTX1                                                              151
      CALL ABLATE(0)                                                         152
      CALL TNEST(HTCONV(5),RMELT,EP)                                         153
      EP = ABS(EP)                                                           154
      KRM = RMELT                                                            155
      COUNT(3) = COUNT(3) + 1.                                               156
      GO TO (275,54,265),KRM                                                 157
  265 II = KONVAR(6)*KONVAR(1) + 1                                           158
      WRITE(6,500) HTCONV(5),T(II),T(II+1),T(II+2)                           159
      GO TO 54                                                               160
C                       NOW CALL INTPTS TO COMPUTE THE                       161
C                       VALUES IMPLICITLY.                                   162
  275 CALL INTPTS(-1,KONVAR(3))                                              163
      IF(IMEX) 156,276,276                                                   164
C                       COMPUTE THE VALUES FOR THE INTER-FACE.               165
  276 CALL INTFC                                                             166
C                       CALCULATE THE VALUES FOR                             167
C                       THE AIR-GAP.                                         168
      IF(KONVAR(5)) 55, 56, 55                                               169
   55 CALL AIRGAP                                                            170
C                       CALCULATE THE VALUES AT THE                          171
C                       FRONT-FACE.                                          172
   56 CALL PTX1                                                              173
C                       COMPUTE THE RATE OF MELTING                          174
C                       AND CHARRING.                                        175
  156 CALL ABLATE(0)                                                         176
      IF(IMEX) 57,57,60                                                      177
C                       TEST RATE OF MELT.                                   178
   57 IF(ABS(RMELT1*ETASBX(1))-.001) 60, 60, 58                              179
   58 IF(EPTAB(6)) 60, 60, 59                                                180
C                       USING TNEST, ITERATE ON THE                          181
C                       RATE OF MELTING.                                     182
   59 CALL TNEST(HTCONV(5),RMELT,EP)                                         183
      EP = ABS(EP)                                                           184
      COUNT(3) = COUNT(3) +1.                                                185
      KRM = RMELT                                                            186
      GO TO (60, 54, 159),KRM                                                187
  159 II = KONVAR(6)*KONVAR(1) +1                                            188
      WRITE (6,500) HTCONV(5),T(II),T(II+1),T(II+2)                          189
      GO TO 54                                                               190
C                       COMPUTE THE HEAT BALANCE.                            191
   60 CALL HTBLNS(1)                                                         192
C                       PRINT OUTPUT                                         193
      CALL OUTPUT(0)                                                         194
C****         CHECK TO SEE IF IT IS TIME FOR THE TAPE INTERRUPT.             195
      IF( GENRL(8) .EQ. 0.0 .OR. CTIME .LE. GENRL(8)) GO TO 69               196
      CALL MDUMP (MK)                                                        197
      GENRL(8) = 0.0                                                         198
C****         WHEN MK =                                                      199
C****              0, MEANS CHECKPOINT WAS SUCCESSFUL.                       200
C****              +, MEANS THE RESTART WAS SUCCESSFUL.                      201
C****              -, MEANS THE RESTART TAPE WAS NOT GENERATED.              202
      IF(MK) 69,69,68                                                        203
   68 ICON = 2                                                               204
      GO TO 110                                                              205
C                       CHECK TO MAKE SURE THAT                              206
C                       ENTIRE LENGTH IS NOT CHARRED                         207
C                       OR MELTED AWAY.                                      208
   69 IF(SMELT(KT+1)-HTCONV(9)) 70,71,71                                     209
C                       INITIALIZE FOR NEXT TIME STEP.                       210
   70 CALL INIT(2)                                                           211
      GO TO 18                                                               212
   71 WRITE (6,501)                                                          213
C                       RUN IS COMPLETED, CALL INIT                          214
C                       TO START NEXT CASE                                   215
   75 CALL INIT(3)                                                           216
      GO TO 90                                                               217
      CALL INIT(3)                                                           218
C****          IF GENRL 4  = 0  ALLNEW MUST = 1 TO RUN MULT. CASES.          219
   90 IF(GENRL(4)) 97,95,97                                                  220
   95 IF(ALLNEW) 97,100,97                                                   221
C****          IF END = 1 NEXT CASE USES ALL NEW INPUT.                      222
   97 IF(END) 102,103,102                                                    223
  102 ICON = 1                                                               224
      GO TO 110                                                              225
  103 ICON = 2                                                               226
      GO TO 110                                                              227
  100 WRITE (6,105)                                                          228
  105 FORMAT (1HO,39HCANNOT USE VARIABLE TEMP WITHOUT ALLNEW)                229
  110 RETURN                                                                 230
  500 FORMAT(1H0,3X,6HSPM = E18.8,3X,9HT(1-3) = 3E20.8)                      231
  501 FORMAT(1HO,4X,25H ENTIRE LAYER MELTED AWAY)                            232
      END                                                                    233
$IBFTC HTBLNS
      SUBROUTINE HTBLNS(IKBLN)                                                 1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATIONS FOR THIS ROUTINE ARE DEFINED AND DISCUSSED        62
C****         IN SECTION IX, ACCURACY OF THE PROGRAM.                         63
C                       THIS SUBROUTINE CALCULATES THE HEAT BALANCE           64
C                       FOR THE PROGRAM.  IT IS STORED IN QI.                 65
      DIMENSION QI(2,10),QIDOT(2,10),TMP(5)                                   66
      LAYER = KONVAR(4)                                                       67
C****         SEE IF AIRGAP IS LAST LAYER.                                    68
      IF (IKBLN) 1,5,1                                                        69
    1 IF(KONVAR(5) -LAYER) 2,4,2                                              70
    2 MN = KONVAR(1)                                                          71
      II = KONVAR(1)*(KONVAR(6)+1)                                            72
      KTIME = KONVAR(2)                                                       73
      TERM = 3.*T(II)-4.*T(II-1)+T(II-2)                                      74
      MN1 = (INDTL(4)+1)*(3*(KONVAR(4)-1)+1)+1                                75
      CALL TABUP(WARM,PROPT(MN1),T(II),CAYUP,INDTL(4),1)                      76
      Q(KTIME+1,6) = -CAYUP*ETASBX(MN)*TERM/2./DELETA(LAYER)                  77
      GO TO 6                                                                 78
C****         IF LAST IS AIRGAP     DO TABLE LOOK UP ON BACKFC                79
    4 CALL TABUP (HORA,TTABL,CTIME,TIVAR(5),INDTL(5),5)                       80
      Q(KTIME+1,6) = TIVAR(5)                                                 81
    5 IF(OUTTB(19)) 600,6,600                                                 82
C                       IF KBLNS = 0.  THE ROUTINE                            83
C                       WAS CALLED FROM STARTT.                               84
C                       IF KBLNS = 1.  THE ROUTINE WAS                        85
C                       CALLED FROM EXEC.                                     86
    6 QITOT = 0.0                                                             87
      N0 = 5 - KONVAR(3)                                                      88
      KTM = KONVAR(2)                                                         89
      KT1 = KTM + 1                                                           90
      IF(IKBLN) 50, 8, 50                                                     91
    8 DT = ABS(GENRL(3))                                                      92
      LAYER = KONVAR(4)                                                       93
      IF(GENRL(3)) 10, 10, 15                                                 94
C****              CONSTANT HEAT FLUX                                         95
   10 DO 11 K = 1,6                                                           96
   11 Q(KT1,K+6) = DT*Q(KT1,K)                                                97
      QITOT = Q(KT1,7)                                                        98
      GO TO 20                                                                99
C****              LINEAR HEAT FLUX                                          100
   15 DO 16 K = 1,6                                                          101
   16 Q(KT1,K+6) = DT*Q(KT1,K)/2.                                            102
      QITOT = Q(KT1,7)                                                       103
   20 Q(4,13) = QITOT                                                        104
      QIDOT(2,1) = Q(KT1,1)                                                  105
      QI(2,1) = QITOT                                                        106
      DO 25 I = 2,10                                                         107
      QIDOT(2,I) = 0.0                                                       108
   25 QI(2,I) = 0.0                                                          109
      GO TO 550                                                              110
C****              TRAPEZOIDAL RULE FOR Q-S.                                 111
   50 DO 55 J = 7,12                                                         112
   55 Q(KT1,J) = Q(KTM,J) + .5*DELTO(KTM)*(Q(KT1,J-6)+Q(KTM,J-6))            113
      DO 500 J = 1,LAYER                                                     114
C****              SKIP FOR THE AIRGAP                                       115
      IF(J-KONVAR(5)) 56,70,56                                               116
   56 CONTINUE                                                               117
      MNP = 1 + (J-1)*3*(INDTL(4)+1)                                         118
      NPTS = PTSIN(J)+1.                                                     119
      TDN = 2. * DELETA(J)                                                   120
      IF (IMEX .EQ. -1) GO TO 61                                             121
C****              CALL BEE FOR EXPLICIT POINTS ONLY.                        122
      DO 60 N = N0,NPTS,2                                                    123
      II = KONVAR(6) * KONVAR(1) + JLAYER(J) + N                             124
      MN = JLAYER(J) + N                                                     125
      IF(KONVAR(7) - 2) 58, 57, 58                                           126
   57 CALL DEE(II, MN)                                                       127
   58 CALL CHARP(II,J)                                                       128
      CALL BEE(II,MN,J,ITTEMP)                                               129
   60 CONTINUE                                                               130
   61 NFFC = KONVAR(6) * KONVAR(1) + JLAYER(J) + 1                           131
      NBFC = KONVAR(6) * KONVAR(1) + JLAYER(J) + NPTS +1                     132
      MNFFC = JLAYER(J) + 1                                                  133
      MNBFC = JLAYER(J)  + NPTS +1                                           134
      IF(KONVAR(7) - 2) 63, 62, 63                                           135
   62 CALL DEE(NFFC, MNFFC)                                                  136
   63 CALL CHARP(NFFC,J)                                                     137
      CALL BEE(NFFC,MNFFC,J,ITTEMP)                                          138
      IF(KONVAR(7) - 2) 65, 64, 65                                           139
   64 CALL DEE ( NBFC, MNBFC)                                                140
   65 CALL CHARP(NBFC,J)                                                     141
C****         IF OTHER THAN CARTESIAN COORDINATES ARE USED WE  ASSUME        142
C****              THAT THE LAST POINT HAS THE SAME BETA-S AS THE            143
C****              PREVIOUS POINT.                                           144
   66 IF(GENRL(9)) 67, 69, 67                                                145
   67 DO 68 I = 1,4                                                          146
      BETA(I,MNBFC) = BETA(I,MNBFC-1)                                        147
   68 CONTINUE                                                               148
      GO TO 70                                                               149
   69 CALL BEE( NBFC,MNBFC,J,ITTEMP)                                         150
   70 NPTSS = NPTS+1                                                         151
      DO 400 I = 1,NPTSS                                                     152
      II = KONVAR(6)*KONVAR(1)+I + JLAYER(J)                                 153
      JJ = II-KONVAR(1)                                                      154
      MN = JLAYER(J)+I                                                       155
      CALL CHARP(II,J)                                                       156
      IF(KONVAR(7) - 2) 75, 80, 75                                           157
   75 CALL TABUP(WARM,PROPT(MNP),T(II),PROP,INDTL(4),-2)                     158
      CAY = PROP(2)*CHARV(1)                                                 159
      GO TO 90                                                               160
   80 CALL KEFFS(II,MN)                                                      161
      CAY = HTCONV(15)                                                       162
   90 IF(J-1) 101, 103, 101                                                  163
  101 EXX = 0.0                                                              164
      EX = 1./THIKN(J)                                                       165
      GO TO 109                                                              166
  103 EXX = ETAXX(MN)                                                        167
      EX = ETASBX(MN)                                                        168
  109 CALL DFINTC(DENS,II,MN,J,RHON,SD)                                      169
      CALL DFINTC(T,II,MN,J,TN,SD)                                           170
      RHON = RHON/TDN                                                        171
      TN = TN/TDN                                                            172
  130 TT = (T(II)-T(JJ))/DELTO(KTM)                                          173
      S4BAR = BETA(1,MN)*RHON*CHARV(2)/CHARV(1)                              174
      TRM1 = CAY*EX/BETA(1,MN)                                               175
      TRM2 = BETA(1,MN)*EXX/EX**2-BETA(3,MN) + S4BAR                         176
      IF (J-KONVAR(5)) 150,140,150                                           177
  140 TTI = (T(II+1)-T(JJ+1))/DELTO(KTM)                                     178
C****         QINT IS DEFINED IN EQUATION IX.6.                              179
      QINT = THIKN(J)*DENSE(J)*PROP(1)*(TT+TTI)/2.                           180
      TT = TTI                                                               181
      JI = II + 1                                                            182
      GO TO 410                                                              183
  150 IF(I-1) 160,155,160                                                    184
  155 DX = 0.0                                                               185
      GO TO 170                                                              186
  160 IF(I-NPTS) 165,168,165                                                 187
  165 DX = DELETA(J)                                                         188
      GO TO 170                                                              189
  168 DX = ABS(XLOC(MN) - XLOC(MN-1))                                        190
      DX = DX * ETASBX(MN)                                                   191
C****         QINT IS DEFINED IN EQUATION IX.4                               192
  170 QINT = CLCINT(0,DX,TRM1*(TT+TRM2*TN-BETA(4,MN)),TMP)                   193
  400 CONTINUE                                                               194
      JI = II                                                                195
  410 IF(J-LAYER) 411,412,411                                                196
  411 CALL TABUP(WARM,CTABL,T(JI),CI,INDTL(4),J)                             197
      GO TO 416                                                              198
  412 IF(J-KONVAR(5)) 415,411,415                                            199
  415 CI = 0.0                                                               200
  416 QIDOT(2,J) = QINT + CI*TT                                              201
C****         TRAPEZOIDAL RULE FOR QI TOTAL.                                 202
      QI(2,J) = QI(1,J)+DELTO(KTM)*(QIDOT(2,J)+QIDOT(1,J))/2.                203
      QITOT = QITOT+QI(2,J)                                                  204
  500 CONTINUE                                                               205
      QITOT = QITOT + Q(KTM,12)                                              206
      Q(4,13) = QITOT                                                        207
C****              SET UP VALUES FOR NEXT TIME STEP.                         208
  550 DO 560 J = 1,10                                                        209
      QIDOT(1,J) = QIDOT(2,J)                                                210
      QI(1,J) = QI(2,J)                                                      211
  560 CONTINUE                                                               212
  600 RETURN                                                                 213
      END                                                                    214
$IBFTC INIT
      SUBROUTINE INIT(LL)                                                      1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C************COMMON FOR VARIABLE T-P-D INPUT*******FOR BETA-4 TABLE****       62
      DIMENSION TMDENS(1),TMT(1),TMP(1),XFORT(1),XFORP(1),XFORDN(1)           63
C     ABOVE IS DUMMY DIMENSION -JUST TO ALLOW SUBSCRIBTING                    64
      EQUIVALENCE(TMDENS(1),DENS(301)),(TMT(1),T(301)),(TMP(1),P(301))        65
      EQUIVALENCE(XFORT(1),T(151)),(XFORP(1),P(151)),(XFORDN(1),DENS(151      66
     1))                                                                      67
      EQUIVALENCE(NT,T(449)),(NXT,T(450)),(NP,P(449)),(NXP,P(450))            68
      EQUIVALENCE(ND,DENS(449)),(NXD,DENS(450))                               69
C     THE T-P-AND DENS INPUTS ARE STORED IN THE                               70
C     LAST THIRD OF THEIR RESPECTIVE ARRAYS.                                  71
C     NT-NP-NDENS ETC ARE STORED IN LOC                                       72
C     NOT USED -DUE TO THE IMPOSSIBILITY OF HAVING 150 POINTS                 73
C     THE X TABLE FOR T(XFORT)ETC ARE STORED IN THE                           74
C     MIDDLE THIRD OF THEIR RESPECTIVE ARRAYS                                 75
C     FOR THE BETA 4 TABLE HAVING PSEUDO - VARIABLE DIMENSION                 76
      COMMON TXQTAB(200),NOFTS,NOFXS,NTXQ(50),ICON,JCON,END                   77
C****              THIS SUBROUTINE INITIALIZES THE INPUT.                     78
C****              IT SETS UP CONSTANTS, COMPUTES THE X-LOCATIONS,            79
C****              ETA-S,DELETA-S,ETC. LL = 1                                 80
C****              IT ALSO INITIALIZES FOR THE NEXT TIME STEP                 81
C***               LL = 2, AND FOR THE NEXT CASE LL = 3                       82
C****              LL = 4 REINITIALIZES AFTER AN MDUMP RESTART.               83
      L = LL                                                                  84
      GO TO ( 10, 150, 190, 191, 15 ),L                                       85
C****              PRIMARY INITIALIZATION                                     86
   10 KONVAR(5) = AGPTB(1)*1.01                                               87
      NOFTS = NTXQ(1)                                                         88
      NOFXS = NTXQ(2)                                                         89
      TIME = GENRL(1)                                                         90
      CTIME = TIME + ABS(GENRL(3))                                            91
      TMELT(8) = TMELT(8)*HTCONV(3)                                           92
      TMELT(9) = TMELT(9)*HTCONV(3)                                           93
      KONVAR(2) = 1                                                           94
      KONVAR(3) = 3                                                           95
      LAYER = ABS(GENRL(6)) * 1.01                                            96
      KONVAR(4) = LAYER                                                       97
      KONVAR(6) = 1                                                           98
      KONVAR(7) = CHART(1)*1.01                                               99
      KONVAR(8) = TMELT(1)*1.01                                              100
      COUNT(1) = 1.                                                          101
C****              POINT TO RESTART FROM MDUMP.                              102
   15 HTCONV(9) = THIKN(1)                                                   103
      ZERO = 0.0                                                             104
C****              CALL ENLARG TO FILL UP THE TABLES                         105
C****                        IF NECESSARY.                                   106
      CALL ENLARG                                                            107
C****              COMPUTE THE DK/DT TABLE BY CALLING DIFTAB.                108
C****              COMPUTE SUBSCRIPTS TO USE FOR FIRST LOCATION              109
C****              OF THE CK TABLE AND DK/DT TABLE.                          110
   30 NT1 = INDTL(4)+1                                                       111
      DO 35 MN1 = 1,LAYER                                                    112
      MN11 = MN1-1                                                           113
      MN2 = NT1*(3*MN11+1)+1                                                 114
      MN3 = NT1*(3*MN11+2)+1                                                 115
      IF(PROPT(MN3))  35, 34, 35                                             116
   34 CALL DIFTAB(PROPT(MN2),WARM,PROPT(MN3),INDTL(4),1)                     117
   35 CONTINUE                                                               118
C****              TEST TO SEE IF CHARRING OPTION IS USED.                   119
      IF (KONVAR(7)) 50,50,40                                                120
   40 I = 3*NT1+1                                                            121
      J = 4*NT1+1                                                            122
C****              COMPUTE THE DIFFERENTIAL OF M-BAR                         123
      CALL DIFTAB(GASPR(I),WARM,GASPR(J),INDTL(4),1)                         124
   50 IF (KONVAR(8)-1) 60,55,60                                              125
   55 L = 6*(INDTL(5)+1)+1                                                   126
      K = L+INDTL(5)+1                                                       127
C****              COMPUTE THE DERIVATIVE OF S-CHAR-MAX.                     128
      CALL DIFTAB(TTABL(L),HORA,TTABL(K),INDTL(5),1)                         129
   60 IF(KONVAR(7)) 61, 64, 61                                               130
C****              THERE IS CHAR, SO TEST FOR A DENSITY                      131
C****                        OF CHAR                                         132
   61 IF (CHART(2)) 62,62,64                                                 133
   62 CALL ERROR (6,32H THE DENSITY IS ZERO OR NEGATIVE  )                   134
   64 IF (KONVAR(5)-1) 68,65,68                                              135
   65 CALL ERROR (5,26H THE AIR GAP CANT BE FIRST)                           136
   68 DO 80 J = 1,LAYER                                                      137
      IF (THIKN(J)) 70,78,70                                                 138
   70 IF (DENSE(J)) 72,78,72                                                 139
   72 IF (PTSIN(J)) 80,74,80                                                 140
   74 IF (J-KONVAR(5)) 78,80,78                                              141
   78 CALL ERROR (7,40H EITHER DENSE, PTSIN, OR THIKN IS ZERO  )             142
   80 CONTINUE                                                               143
C****              PTSIN MUST BE ODD                                         144
      JLAYER(1) = 0                                                          145
      DO 87 J = 1,LAYER                                                      146
      EX = PTSIN(J)/2.                                                       147
      KX = IFIX(EX)                                                          148
      FX = FLOAT(KX)                                                         149
      IF( J .EQ. KONVAR(5)) GO TO 84                                         150
      IF(EX .NE. FX) GO TO 85                                                151
   83 PTSIN(J) = PTSIN(J)+1.                                                 152
      GO TO 85                                                               153
   84 PTSIN(J) = 0.                                                          154
   85 DELETA(J) = 1./(PTSIN(J)+1.)                                           155
      NPTS = PTSIN(J-1)                                                      156
      IF (J-1) 86,87,86                                                      157
   86 JLAYER(J) = JLAYER(J-1)+NPTS+1                                         158
   87 CONTINUE                                                               159
      LAYER1 = LAYER + 1                                                     160
      NPTS = PTSIN(LAYER)                                                    161
      JLAYER(LAYER1) = JLAYER(LAYER) + NPTS + 1                              162
C****              BLOCK TO COMPUTE ETASBX(MN)                               163
      DO 95 J = 1,LAYER                                                      164
      J1 = LAYER+1-J                                                         165
      NPTS2 = PTSIN(J1)+2.                                                   166
      DO 90 K = 1,NPTS2                                                      167
      MN = JLAYER(J1)+K                                                      168
   90 ETASBX(MN) = 1./THIKN(J1)                                              169
   95 CONTINUE                                                               170
C****              TEST FOR ROUND OFF IN THE MACHINE.                        171
      IF (GENRL(4)-WARM(1)) 97,97,98                                         172
   97 WARM(1) = WARM(1)*.99999                                               173
   98 NPTS3 = PTSIN(LAYER)+2.                                                174
      KONVAR(1) = JLAYER(LAYER)+NPTS3                                        175
C****              MAKE SURE TNEST IS CLEARED                                176
      CALL TNEST(ZERO,ZERO,ZERO)                                             177
      GO TO 300                                                              178
C****              BLOCK TO PREPARE FOR NEXT TIME STEP.                      179
C****              ALTERNATE KONVAR(3) BETWEEN 2 AND 3.                      180
  150 KONVAR(3) = 5-KONVAR(3)                                                181
C****              UPDATE OR RE-INITIALIZE COUNTERS.                         182
      COUNT(1) = COUNT(1)+1.                                                 183
      COUNT(2) = COUNT(2)+COUNT(3)                                           184
      COUNT(3) = 0.                                                          185
      COUNT(4) = COUNT(4)+COUNT(5)                                           186
      COUNT(5) = 0                                                           187
      COUNT(6) = COUNT(6)+COUNT(7)                                           188
      COUNT(7) = 0.                                                          189
      COUNT(8) = COUNT(8)+COUNT(9)                                           190
      COUNT(9) = 0.                                                          191
      COUNT(10) = COUNT(10)+COUNT(11)                                        192
      COUNT(11) = 0.                                                         193
      COUNT(12) = COUNT(12)+COUNT(13)                                        194
      COUNT(13) = 0.                                                         195
  155 IF( KONVAR(2) .NE. 1) GO TO 159                                        196
  156 KONVAR(2) = KONVAR(2)+1                                                197
      GO TO 300                                                              198
  159 KPTS = 2*KONVAR(1)                                                     199
      DO 160 JTRANS = 1, KPTS                                                200
      MTIME = KONVAR(1)+JTRANS                                               201
      DENS(JTRANS) = DENS(MTIME)                                             202
      P(JTRANS) = P(MTIME)                                                   203
      T(JTRANS) = T(MTIME)                                                   204
  160 CONTINUE                                                               205
      IF(KONVAR(2) .NE. 3) GO TO 175                                         206
  161 DO 164 J = 2,3                                                         207
      K = J-1                                                                208
      DELTO(K) = DELTO(J)                                                    209
      SMELT(K) = SMELT(J)                                                    210
  164 SCHAR(K) = SCHAR(J)                                                    211
      SCHAR(3) = SCHAR(4)                                                    212
      SMELT(3) = SMELT(4)                                                    213
  167 DO 168 I = 1,12                                                        214
      DO 168 J = 2,4                                                         215
      K = J-1                                                                216
      Q(K,I) = Q(J,I)                                                        217
  168 CONTINUE                                                               218
      GO TO 300                                                              219
  175 KONVAR(2) = 3                                                          220
      GO TO 300                                                              221
C****              BLOCK TO PREPARE NEXT CASE.                               222
  190 CALL OUTPUT(1)                                                         223
C****              FIRST PRINTOUT OUTPUT.                                    224
      THIKN(1) = HTCONV(9)                                                   225
  191 DO 192 I = 1,5                                                         226
      CHARV(I) = 0.0                                                         227
  192 SPACVR(I) = 0.0                                                        228
      DO 195 I = 1,4                                                         229
      SMELT(I) = 0.0                                                         230
      DELTO(I) = 0.0                                                         231
      SCHAR(I) = 0.0                                                         232
      DO 193 J = 1,13                                                        233
  193 Q(I,J) = 0.0                                                           234
      DO 194 K = 1,150                                                       235
  194 BETA(I,K) = 0.0                                                        236
  195 CONTINUE                                                               237
      DO 196 I = 1,25                                                        238
      AUS(I) = 0.0                                                           239
      COUNT(I) = 0.0                                                         240
  196 KONVAR(I) = 0                                                          241
      DO 197 I = 1,150                                                       242
      EMDG(I) = 0.0                                                          243
      ETASBT(I) = 0.0                                                        244
      ETASBX(I) = 0.0                                                        245
      ETAXX(I) = 0.0                                                         246
      WDOTP(I) = 0.0                                                         247
  197 XLOC(I) = 0.0                                                          248
      DO 198 I = 1,450                                                       249
      DENS(I) = 0.0                                                          250
      P(I) = 0.0                                                             251
  198 T(I) = 0.0                                                             252
      DO 199 I = 1,10                                                        253
      DELETA(I) = 0.0                                                        254
      TIVAR(I) = 0.0                                                         255
      HEVAR(I) = 0.0                                                         256
  199 JLAYER(I) = 0                                                          257
      DO 203 I = 4,25                                                        258
  203 HTCONV(I) = 0.0                                                        259
      IMPTME = 0                                                             260
      IF ( L .NE. 4) GO TO 302                                               261
      ALLNEW = 0.0                                                           262
      GENRL(4) = 0.0                                                         263
      NTXQ(1) = 0                                                            264
      NTXQ(2) = 0                                                            265
      NOFXS = 0.0                                                            266
      NOFTS = 0.0                                                            267
      END = 0.                                                               268
      DO 204 I = 1,404                                                       269
  204 CHART(I) = 0.0                                                         270
      DO 205 I = 16,45                                                       271
  205 AGPTB(I) = 0.0                                                         272
      DO 206 I = 8,3378                                                      273
  206 EPTAB(I) = 0.0                                                         274
      DO 207 I = 1,9                                                         275
  207 CHARV(I) = 0.0                                                         276
      DO 208 I = 1,25                                                        277
  208 COUNT(I) = 0.0                                                         278
      DO 209 I = 1,4                                                         279
      DO 209 JD = 1,13                                                       280
  209 Q(I,JD) = 0.0                                                          281
      DO 210 I = 1,21                                                        282
  210 DELETA(I) = 0.0                                                        283
      DO 211 I = 1,54                                                        284
  211 SMELT(I) = 0.0                                                         285
      DO 212 I = 1,15                                                        286
  212 DELTO(I) = 0.0                                                         287
      DO 213 I = 1,4                                                         288
      DO 213 JD = 1,150                                                      289
  213 BETA(I,JD) = 0.0                                                       290
      DO 1214 I = 1,2250                                                     291
 1214 DENS(I) = 0.0                                                          292
      CTIME = 0.0                                                            293
      TIME = 0.0                                                             294
      DO 214 I = 4,50                                                        295
  214 HTCONV(I) = 0.0                                                        296
      DO 215 I = 1,23                                                        297
  215 TIVAR(I) = 0.0                                                         298
      DO 216 I = 1,25                                                        299
  216 AUS(I) = 0.0                                                           300
      DO 217 I = 1,16                                                        301
  217 AMPLCT(I) = 0.0                                                        302
      WRITE ( 6,1001)                                                        303
  300 KONVAR(6) = MIN0(2,KONVAR(2))                                          304
      RETURN                                                                 305
 1001 FORMAT (1H1)                                                           306
  302 RETURN                                                                 307
      END                                                                    308
$IBFTC INITBD
      BLOCK DATA                                                               1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DATA EPTAB/.2,.01,3*.0001,.01,.0001/                                    62
      DATA AGPTB/9*0.0,.11,2.E5,.2,.071,.25,.33/                              63
      DATA HTCONV/1.9858,.476E-12,1.74532925E-2/                              64
      DATA HEAD(1)/6H(74H1 /,HEAD(14)/6H     )/                               65
      END                                                                     66
$IBFTC INTPTS
      SUBROUTINE INTPTS(KT,NT)                                                 1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE INTERIOR POINTS OF EACH LAYER ARE DISCUSSED IN              62
C****         SECTION IV OF THE ANALYSIS BY P. GORDON                         63
      J2 = KT                                                                 64
      KEX = KT                                                                65
      N1 = NT                                                                 66
      IT = KONVAR(1)                                                          67
      KTIM = KONVAR(2)                                                        68
C****          WHEN                                                           69
C****              KEX = 0.,USE EXPLICIT EQUATIONS.                           70
C****              KEX = -1,USE IMPLICIT EQUATIONS.                           71
C****              KEX IS GREATER THAN ZERO, EVALUATE ONE                     72
C****                   OR MORE POINTS BY THE IMPLICIT                        73
C****                   EQUATIONS.                                            74
      IF (IMEX) 300,4,10                                                      75
    4 IF(KEX) 100,5,191                                                       76
    5 IF (KONVAR(2)-1) 50,10,50                                               77
C****              NOW USE THE EXPLICIT SCHEME FOR                            78
C****                   THE FIRST TIME STEP.                                  79
   10 K = 1                                                                   80
      L = KONVAR(4)                                                           81
      DO 40 J = 1,L                                                           82
C****         RZ IS DEFINED BY EQUATION IV.4                                  83
   12 RZ = DELTO(KTIM)/DELETA(J)**2                                           84
C****              STORES THE FIRST GUESS OF THE INTER-FACE TEMPERATURES      85
      NPTS = PTSIN(J)+1.                                                      86
      JJ1 = JLAYER(J) + 1                                                     87
      IJ1 = JJ1 + KONVAR(1)*KONVAR(6)                                         88
      T(IJ1) = T(JJ1)                                                         89
      IJ2 = IJ1 + NPTS                                                        90
      JJ2 = JJ1 + NPTS                                                        91
      IF(J-KONVAR(5)) 15, 39, 15                                              92
   15 DO 30 I = 2,NPTS                                                        93
      MN = JLAYER(J) + I                                                      94
      II = KONVAR(1)*KONVAR(6) + I + JLAYER(J)                                95
      JJ = II-KONVAR(1)                                                       96
C***          R1 IS DEFINED BY EQUATION IV.5                                  97
      R1 = (T(JJ+1)-T(JJ-1))/2./DELETA(J)                                     98
C***          R2 IS DEFINED BY EQUATION IV.56                                 99
      R2 = T(JJ+1)+T(JJ-1)                                                   100
C****              CALL CHARP TO CALCULATE CPA,AK,AKP.                       101
      CALL CHARP(JJ,J)                                                       102
C****         IF CHARRING IN THE FIRST LAYER COMPUTE M-DOT-G                 103
      IF (CHART(1)) 17,21,17                                                 104
   17 IF(J-1) 21, 20, 21                                                     105
   20 CALL EMG(JJ)                                                           106
C****         COMPUTE THE BETA COEFFICIENTS OF THE T EQUATION                107
   21 CALL BEE(JJ,MN,J,ITTEMP)                                               108
      BB3 = BETA(3,MN) + BETA(2,MN)*R1                                       109
      IF (BB3) 25,23,25                                                      110
   23 ALPHA = .5                                                             111
      GO TO 26                                                               112
   25 RBDN = BETA(1,MN)/(ABS(BB3))/DELETA(J)                                 113
      ALPHA = AMIN1(.5,RBDN)                                                 114
   26 IF (BB3) 27,28,28                                                      115
   27 ALF1 = ALPHA                                                           116
      ALF2 = 1.-ALPHA                                                        117
      GO TO 29                                                               118
   28 ALF1 = 1.-ALPHA                                                        119
      ALF2 = ALPHA                                                           120
C***          R3 IS DEFINED BY EQUATION IV.8                                 121
   29 R3 = T(JJ)+RZ*((BETA(1,MN)+ALF1*DELETA(J)*BB3)*T(JJ+1)+(BETA(1,MN)     122
     1-ALF2*DELETA(J)*BB3)*T(JJ-1))+DELTO(KTIM)*BETA(4,MN)                   123
C****              NOW, COMPUTE THE TEMPERATURE.                             124
C***          T(II) IS DEFINED IN EQUATION IV.9                              125
      T(II) = RZ*((ALF2-ALF1)*DELETA(J)*BB3-2.*BETA(1,MN))*T(JJ)+R3          126
   30 CONTINUE                                                               127
C****              STORES THE 1ST GUESS FOR THE BACK-FACE TEMPERATURE        128
   39 T(IJ2) = T(JJ2)                                                        129
   40 CONTINUE                                                               130
      GO TO 200                                                              131
   50 DELTTR = DELTO(KTIM)/DELTO(KTIM-1)                                     132
      K = 1                                                                  133
      DO 60 I = 1,IT                                                         134
      II = 2*KONVAR(1)+I                                                     135
      JJ = II-KONVAR(1)                                                      136
C****              EXPLICIT EQUATION FOR AFTER ONE                           137
C****                   TIME STEP.                                           138
C***          T(II) IS DEFINED IN EQUATION IV.10                             139
      T(II) = (DELTTR+1.)*T(JJ)-DELTTR*T(I)                                  140
   60 CONTINUE                                                               141
      GO TO 200                                                              142
C****              EFN 100 STARTS THE IMPLICIT SCHEME.                       143
  100 J1 = 1                                                                 144
      K = 0                                                                  145
      J2 = KONVAR(4)                                                         146
      N2 = 2                                                                 147
      IF (N1-2) 102,101,102                                                  148
  101 N1 = N1+2                                                              149
  102 DO 190 J = J1,J2                                                       150
      IF (J-KONVAR(5)) 103,190,103                                           151
C***          RZ IS DEFINED IN EQUATION IV.4                                 152
  103 RZ = DELTO(KTIM)/DELETA(J)**2                                          153
      NPTS1 = PTSIN(J)                                                       154
      NPTS = NPTS1+4-N1                                                      155
  105 DO189 I = N1,NPTS,N2                                                   156
      IF (KEX) 106,106,110                                                   157
  106 MN = JLAYER(J)+NPTS1+3-I                                               158
      II = KONVAR(6)*KONVAR(1)+MN                                            159
      GO TO 115                                                              160
  110 IF (J-J1) 115,106,114                                                  161
  114 II = II+N6                                                             162
      MN = MN+N6                                                             163
  115 JJ = II-KONVAR(1)                                                      164
C***          R1 IS DEFINED IN EQUATION IV.5                                 165
      R1 = (T(II+1)-T(II-1))/2./DELETA(J)                                    166
C***          R2 IS DEFINED IN EQUATION IV.6                                 167
      R2 = T(II+1)+T(II-1)                                                   168
      T1 = T(II)                                                             169
      EPS = -EPTAB(5)                                                        170
C****              SAVE TEMPERATURE FOR TNEST IN T1.                         171
C****              CALL CHARP FOR CPA,AK,AKP                                 172
      CALL CHARP(II,J)                                                       173
C****              TEST TO SEE IF CHARRING.                                  174
  116 IF (CHART(1)) 117,121,117                                              175
  117 IF (J-1) 121,118,121                                                   176
  118 CALL DENSIT(II,MN,0)                                                   177
      IF(KONVAR(7)-2) 120, 119, 120                                          178
  119 CALL PRESSM(II,MN,J,0)                                                 179
C****         IF CHARRING COMPUTE M-DOT-G                                    180
  120 CALL EMG(II)                                                           181
C****              CALL BEE TO COMPUTE BETA-S.                               182
  121 CALL BEE(II,MN,J,ITTEMP)                                               183
      BB3 = BETA(3,MN)+BETA(2,MN)*R1                                         184
      IF (BB3) 169,168,169                                                   185
  168 ALPHA = .5                                                             186
      GO TO 170                                                              187
  169 RBDN = BETA(1,MN)/(ABS(BB3))/DELETA(J)                                 188
      ALPHA = AMIN1(.5,RBDN)                                                 189
  170 IF (BB3) 171,172,172                                                   190
  171 ALF1 = ALPHA                                                           191
      ALF2 = 1.-ALPHA                                                        192
      GO TO 174                                                              193
  172 ALF1 = 1.-ALPHA                                                        194
      ALF2 = ALPHA                                                           195
C***          R3 IS DEFINED IN EQUATION IV.8                                 196
  174 R3 = T(JJ)+RZ*((BETA(1,MN)+ALF1*DELETA(J)*BB3)*T(II+1)+(BETA(1,MN)     197
     1-ALF2*DELETA(J)*BB3)*T(II-1))+DELTO(KTIM)*BETA(4,MN)                   198
C****              NOW COMPUTE THE TEMPERATURE.                              199
C***          T(II) IS DEFINED BY EQUATION IV.9                              200
      T(II) = R3/(1.+RZ*(2.*BETA(1,MN)+(ALF1-ALF2)*DELETA(J)*BB3))           201
C****              USE TNEST TO ITERATE FOR THE                              202
C****              FINAL TEMP. VALUE. ITTEMP IS                              203
C****              A CONTROL SET IN BEE TO DETERMINE                         204
C****              IF THE ITERATION IS NECESSARY.                            205
C****         STORE ITTEMP IN ANOTHER CELL, IN ORDER TO KEEP FROM            206
C****         OSCILLATING ON ITERATIONS, DUE TO BETA2 IN BEE.                207
  175 IF(EPS) 176,2176, 2176                                                 208
  176 ITTP1 = ITTEMP                                                         209
 2176 IF(ITTP1) 177, 183, 177                                                210
  177 CALL TNEST(T(II),T1,EPS)                                               211
      KT1 = T1                                                               212
      GO TO (183,178,179),KT1                                                213
  178 EPS = ABS(EPS)                                                         214
      T(II) = AMAX1(WARM(1),T(II))                                           215
      COUNT (7) = COUNT(7)+1.                                                216
      GO TO 116                                                              217
  179 WRITE(6,500)   T(II),ALF1,ALF2,BETA(1,MN),BETA(2,MN),BETA(3,MN),       218
     1BETA(4,MN),MN                                                          219
      GO TO 116                                                              220
C****              T1 IS CHANGED IN TNEST                                    221
C****                   1.CONVERGENCE                                        222
C****                   2.NO-CONVERGENCE                                     223
C****                   3.ERROR RETRACE                                      224
C****         COMPUTE M-DOT-G IF CHARRING                                    225
  183 IF (CHART(1)) 184,189,184                                              226
  184 IF (J-1) 189,185,189                                                   227
C****              GO TO EMG TO GET VALUES FOR POINTS                        228
C****                   SKIPPED IN IMPLICIT SCHEME. IF NO                    229
C****                   ITERATION ON T.                                      230
C****              COMPUTE CORRECT M-DOT-G.                                  231
  185 IF(ITTP1) 187, 186, 187                                                232
  186 K7 = II                                                                233
      GO TO 188                                                              234
  187 K7 = II-1                                                              235
  188 CALL EMG(K7)                                                           236
      IF (K7-II+1) 187,189,187                                               237
  189 CONTINUE                                                               238
  190 CONTINUE                                                               239
      GO TO 200                                                              240
C****              COMPUTE INDICES FOR COMPUTATION                           241
C****              OF ONE OR TWO INTERFACE POINTS.                           242
C****                   BLOCK TO COMPUTE LAYER INDICES.                      243
  191 K = 0                                                                  244
      IF (KEX-1) 193,192,193                                                 245
  192 J1 = J2                                                                246
C****              FOR FRONT FACE, POINT N1 IS INPUT                         247
C****                   TO THIS ROUTINE AND EQUALS                           248
C****                   PTSIN(J)+1.                                          249
      N6 = 2                                                                 250
      N2 = PTSIN(J1)+4.                                                      251
      GO TO 102                                                              252
  193 IF(KEX-1-KONVAR(4)) 195, 194, 195                                      253
  194 J1 = J2-1                                                              254
      J2 = J1                                                                255
C****              FOR THE BACKFACE, POINT N1 IS INPUT                       256
C****                   TO THIS ROUTINE AND = 2.                             257
      N2 = PTSIN(J1)+4.                                                      258
      N6 = 2                                                                 259
      GO TO 102                                                              260
  195 IF (KEX-KONVAR(5)) 196,197,196                                         261
  196 J1 = J2-1                                                              262
C****              FOR INTERIOR POINTS N1 = 2.                               263
      N2 = PTSIN(J1)+4.+PTSIN(J2)                                            264
      N6 = 2                                                                 265
      GO TO 102                                                              266
  197 N6 = 3                                                                 267
C****              FOR AIR-GAP,KEX = KONVAR(5)                               268
C****                   AND N1 = 2.                                          269
      J1 = KONVAR(5)-1                                                       270
      N2 = PTSIN(J1)+4.                                                      271
      IF (KONVAR(5)-KONVAR(4)) 198,102,198                                   272
  198 J2 = J2+1                                                              273
      N2 = PTSIN(J1)+PTSIN(J2)+4.                                            274
      GO TO 102                                                              275
  200 RETURN                                                                 276
  300 CALL TMPIMP(1)                                                         277
      GO TO 200                                                              278
  500 FORMAT (1H 16HBEE EFN 177 T = E20.8,3X,5HA1 = E20.8,3X,5HA2 = E20.     279
     18//,3X,5HB1 = E20.8,3X,5HB2 = E20.8,3X,5HB3 = E20.8,3X,5HB4 = E20.     280
     28,4HI = I3)                                                            281
      STOP                                                                   282
      END                                                                    283
$IBFTC KEFFS
      SUBROUTINE KEFFS(III,MNI)                                                1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       62
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           63
     1             (TRAJV(21),TABLD)                                          64
      II = III                                                                65
C****              THIS ROUTINE COMPUTES K(EFF)                               66
C****                K(EFF)-T,K(EFF)-RHO(S)-PRIME AND                         67
C****                STORES THEM IN SCDTB(1-3)                                68
      MN = MNI                                                                69
      RR = TABLD(14)/DENS(II)                                                 70
      RR2 = RR/DENS(II)                                                       71
      RTRM = RR-1.                                                            72
      SCDTB(1) = GRAPH(1) + GRAPH(2) + GRAPH(3)*RTRM                          73
      SCDTB(2) = 0.0                                                          74
      SCDTB(3) = -GRAPH(3)*RR2                                                75
      HTCONV(15) = SCDTB(1)                                                   76
  201 RETURN                                                                  77
      END                                                                     78
$IBFTC KFS
      SUBROUTINE KFS(III,MNI)                                                  1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       62
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           63
     1             (TRAJV(21),TABLD)                                          64
      SCDTB(12) = GRAPH(7)                                                    65
      SCDTB(13) = 0.0                                                         66
      SCDTB(14) = 0.0                                                         67
      SCDTB(15) = 0.0                                                         68
      SCDTB(16) = 0.0                                                         69
C****              K(F) IS STORED IN SCDTB(12)                                70
C****              K(F)-ETA IS STORED IN SCDTB(13)                            71
C****              K(F)-ETA-ETA IS STORED IN SCDTB(14).                       72
      RETURN                                                                  73
      END                                                                     74
$IBFTC MAIN
      COMMON TXQTAB(200),NOFTS,NOFXS,NTXQ(50),ICON,JCON,END                    1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      X=X                                                                     62
      ICON = 1                                                                63
    1 CALL EXEC1                                                              64
      CALL EXEC2                                                              65
      GO TO 1                                                                 66
      END                                                                     67
$IBFTC MDUMP
      SUBROUTINE MDUMP                                                         1
C     THIS IS A DUMMY SUBROUTINE AND SHOULD NOT BE ENTERED                     2
      STOP                                                                     3
      END                                                                      4
$IBFTC MOMENT
      SUBROUTINE MOMENT(XARAY)                                                 1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION XARAY(1)                                                      62
C                       THIS SUBROUTINE CALCULATES THE                        63
C                       MOMENTS OF THE BODY.                                  64
C                       INPUT ARRAY COMMON.                                   65
C                       XSTAR IS THE DISTANCE, FROM THE                       66
C                       FIRST POINT OF THE BODY, TO THE                       67
C                       TEMPERATURE WHERE T= OR IS GREATER                    68
C                       THAN T(AB).                                           69
C                       X IS THE DISTANCE, FROM THE FIRST                     70
C                       POINT OF THE BODY, TO THE POINT IN                    71
C                       QUESTION.                                             72
C                       THE LOCATIONS STRESS (21-26) ARE                      73
C                       WHERE THE INTEGRATED VALUES ARE                       74
C                       STORED.                                               75
C                       THE LOCATIONS STRESS (11-16) ARE                      76
C                       WHERE THE SUM OF THE INTEGRANDS                       77
C                       ARE STORED.                                           78
C                       THE LOCATIONS STRESS (1-7) ARE                        79
C                       WHERE THE INDIVIDUAL VALUES OF THE                    80
C                       INTEGRAND ARE STORED.                                 81
C                       EMOD(I) UNITS ARE IN INCHES.                          82
C                       ALPHA T IS DIMENSIONLESS.                             83
C                      T(REF) IS STORED IN STVAR(2).                          84
C                       T(AB) IS STORED IN STVAR(3).                          85
      NTEMP = INDTL(4)                                                        86
      ITIME = KONVAR(1)                                                       87
      LAYER = KONVAR(4)                                                       88
      IF (GENRL(11)) 1,3,1                                                    89
    1 DO 2 I = 1,ITIME                                                        90
    2 XARAY(I) = XARAY(I)/12.                                                 91
    3 N3 = KONVAR(6)                                                          92
      XLEN = 0.                                                               93
C****              TOTAL LENGTH OF LAYERS IS IN TLEN.                         94
      TLEN = 0.                                                               95
      DO 4 J = 1,LAYER                                                        96
      TLEN = TLEN + THIKN(J)                                                  97
    4 CONTINUE                                                                98
      DO 5 I = 1,30                                                           99
    5 STRESS(I) = 0.                                                         100
      XSTAR = 0.                                                             101
C                       BLOCK TO COMPUTE XSTAR.                              102
C                       (WORK FROM BACK-FACE FORWARD.)                       103
      DO 50 I = 1,ITIME                                                      104
      IT = (N3+1)*ITIME +1 -I                                                105
      IF(T(IT) - STVAR(3)) 50, 60, 60                                        106
   50 CONTINUE                                                               107
      XSTAR = 0.                                                             108
      GO TO 115                                                              109
   60 IT = IT - N3*ITIME                                                     110
C                       THE POINT IS STORED IN IT.                           111
C                       NOW FIND THE LAYER.                                  112
      DO 70 J = 1,LAYER                                                      113
      J = J                                                                  114
      IF (JLAYER(J)-IT) 70,80,80                                             115
   70 CONTINUE                                                               116
      JT = LAYER                                                             117
      GO TO 81                                                               118
C                       THE LAYER IS STORED IN JT.                           119
C                       NOW, COMPUTE ETA.                                    120
   80 JT = J-1                                                               121
   81 IT2 = IT-JLAYER(JT)                                                    122
      IF(JT-1) 90, 85, 90                                                    123
   85 XSTAR = XARAY(IT)                                                      124
      GO TO 115                                                              125
   90 JT1 = JT-1                                                             126
      DO 92 J = 1,JT1                                                        127
      XLEN = XLEN + THIKN(J)                                                 128
   92 CONTINUE                                                               129
      XSTAR = XLEN + XARAY(IT)                                               130
  115 IF (XSTAR) 119,118,119                                                 131
  118 IT2 = 1                                                                132
      JT = 1                                                                 133
  119 XLEN = 0.0                                                             134
      DO 210 J4 = JT,LAYER                                                   135
      NPTS = PTSIN(J4) +2.                                                   136
      IF(J4-KONVAR(5)) 120, 210, 120                                         137
  120 IF(J4-JT-1) 122,121,121                                                138
  121 IT2 = 1                                                                139
  122 DO 199 I4 = IT2,NPTS                                                   140
      XB = 0.0                                                               141
      MN = JLAYER(J4)+I4                                                     142
      II = N3*ITIME+MN                                                       143
      XB = (XLEN + XARAY(MN)-XSTAR)*12.                                      144
      IF(J4-LAYER) 124,124,129                                               145
  124 IF(J4-1) 129,129,125                                                   146
  125 IF(I4-1) 129,126,129                                                   147
  126 XLEN = XLEN + THIKN(J4-1)                                              148
  129 NLA = (J4-1) * 4 * (NDGREE + 1) + 1                                    149
C                       NOW COMPUTE THE MOMENT INTEGRALS.                    150
      NLA = (J4-1) * 4 * (NDGREE + 1) + 1                                    151
      NDGRE2 = NLA + 2 * (NDGREE + 1)                                        152
      CALL TABUP(DGREE,ATETB(NLA), STVAR(2), ATR, NDGREE,1)                  153
      CALL TABUP( DGREE, ATETB(NLA),T(II),ATTAB,NDGREE,1)                    154
      CALL TABUP(DGREE,ATETB(NDGRE2),T(II),TABE,NDGREE,1)                    155
      IF(J4-1) 135, 130, 135                                                 156
  130 STRESS(1) = 1./ETASBX(MN)                                              157
      GO TO 137                                                              158
  135 STRESS(1) = THIKN(J4)                                                  159
  137 STRESS(2) = TABE*STRESS(1)                                             160
      STRESS(3) = STRESS(2)*XB                                               161
      STRESS(4) = STRESS(3)*XB                                               162
      STRESS(7) = ATTAB-ATR                                                  163
      STRESS(5) = STRESS(2)*STRESS(7)                                        164
      STRESS(6) = STRESS(5)*XB                                               165
      IF (I4-IT2) 150,151,150                                                166
  150 IF(I4-NPTS) 155, 151, 155                                              167
  151 PT4 = 1.                                                               168
      GO TO 160                                                              169
  155 PT4 = 2.                                                               170
C                       MAKE THE TRAPEZOIDAL RULE SUM.                       171
  160 STRESS(12) = STRESS(2)*PT4+STRESS(12)                                  172
      STRESS(13) = STRESS(3)*PT4+STRESS(13)                                  173
      STRESS(14) = STRESS(4)*PT4+STRESS(14)                                  174
      STRESS(15) = STRESS(5)*PT4+STRESS(15)                                  175
      STRESS(16) = STRESS(6)*PT4+STRESS(16)                                  176
  199 CONTINUE                                                               177
C****              NOW DIVIDE BY 2.0 AND MULT. BY DELETA(J4)                 178
C****              COMPUTE TOTAL SUM AND CONVERT TO INCHES.                  179
      DEN = DELETA(J4) * 12./2.                                              180
  200 STRESS(22) = STRESS(12)*DEN+STRESS(22)                                 181
      STRESS(23) = STRESS(13)*DEN+STRESS(23)                                 182
      STRESS(24) = STRESS(14)*DEN+STRESS(24)                                 183
      STRESS(25) = STRESS(15)*DEN+STRESS(25)                                 184
      STRESS(26) = STRESS(16)*DEN+STRESS(26)                                 185
C                       CLEAN OUT STRESS(11-16) FOR                          186
C                       NEXT LAYER.                                          187
      DO 205 J8 =  1,16                                                      188
      STRESS(J8) = 0.                                                        189
  205 CONTINUE                                                               190
  210 CONTINUE                                                               191
C                       NOW SET UP OUTPUT                                    192
      STRESS(31) = STRESS(25)                                                193
      STRESS(32) = STRESS(22)                                                194
      STRESS(33) = STRESS(26)-(STRESS(23)*STRESS(25))/STRESS(22)             195
      STRESS(34) = STRESS(24)-(STRESS(23)**2)/STRESS(22)                     196
      STRESS(35) = (TLEN - XSTAR) * 12.                                      197
      STRESS(36) = STRESS(23)/STRESS(22)                                     198
      STRESS(37) = STRESS(33)/STRESS(34)                                     199
      STRESS(38) = STRESS(25)/STRESS(22)                                     200
      STRESS(39) = SQRT(12.*STRESS(34)/STRESS(22))                           201
      STRESS(40) = STRESS(37)/2.                                             202
      STRESS(41) = STRESS(38)+STRESS(40)*STRESS(39)                          203
      STRESS(42) = STRESS(38)-STRESS(40)*STRESS(39)                          204
      STRESS(43) = STRESS(22)/STRESS(39)                                     205
C                       NOW WRITE OUT OUTPUT                                 206
      WRITE(6,500)STRESS(31),STRESS(32),STRESS(33),STRESS(34),STRESS(35)     207
     1,STRESS(36),STRESS(37),STRESS(38),STRESS(41),STRESS(42),STRESS(39)     208
     2,STRESS(43)                                                            209
C                       FORMAT STATEMENTS                                    210
  500 FORMAT (1H04X,9HI(EAT) = E15.8,3X,7HI(E) = E15.8,3X,10HI(EATZ) = E     211
     115.8//5X,9HI(EZZ) = E15.8,4X,9HT(ACT) = E15.8,3X,11HCENTROID = E15     212
     2.8//5X,7HMBAR = E15.8,3X,7HPBAR = E15.8,4X,17HALPHA T(OUTER) = E15     213
     3.8//5X,17HALPHA T(INNER) = E15.8,3X,9HT(EFF) = E15.8,3X,9HE(EFF) =     214
     4 E15.8)                                                                215
  216 RETURN                                                                 216
      STOP                                                                   217
      END                                                                    218
$IBFTC NSUBT
      SUBROUTINE NSUBT                                                         1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATION FOR THE PARTIAL DERIVATIVE OF ETA WITH             62
C****         RESPECT TO TIME IS DEFINED IN APPENDIX B                        63
      LT = PTSIN(1)+2.                                                        64
      C = SPACE(6)                                                            65
      LAYER = KONVAR(4)                                                       66
      ETASBT(1) = -ETASBX(1)* HTCONV(5)                                       67
      DO 100 J = 1,LAYER                                                      68
      NPTS = PTSIN(J)+1.                                                      69
      DO 80 I = 1,NPTS                                                        70
      MN = JLAYER(J)+I+1                                                      71
      IF (J-2) 10,75,75                                                       72
   10 TEN = I-1                                                               73
      EN = TEN*DELETA(J)                                                      74
C****         XBAR IS DEFINED IN EQUATION B.1                                 75
      XBAR = ABS(XLOC(MN) - XLOC(1))/THIKN(1)                                 76
      IF (SPACVR(1)) 20,15,20                                                 77
   15 ENR = EN*(1.-EN)/2.                                                     78
      GO TO 50                                                                79
   20 AOR = THIKN(1)/SPACVR(1)                                                80
C****         ENR, ETA-SUB-R, IS DEFINED IN EQUATION B.6.2                    81
      ENR = AOR*(XBAR*ETASBX(MN)/(1.+C*XBAR*(2.*XBAR-1.))-EN*ETASBX(LT)/      82
     1(1.+C))                                                                 83
C****         ETASBT, ETA-SUB-T, IS DEFINED IN EQUATION B.6.1                 84
   50 ETASBT(MN) = ENR*SPACVR(2)-ETASBX(MN)*(1.-XBAR)*HTCONV(5)               85
      GO TO 80                                                                86
   75 ETASBT(MN) = 0.                                                         87
   80 CONTINUE                                                                88
  100 CONTINUE                                                                89
      ETASBT(LT) = 0.0                                                        90
  200 RETURN                                                                  91
      END                                                                     92
$IBFTC OUTPUT
      SUBROUTINE OUTPUT (KERR)                                                 1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION TRAY(150)                                                     62
      DIMENSION XRAY(175)                                                     63
      IF (CTIME .EQ. 0.0  .OR.  CTIME .NE. PRVTME) GO TO 8                    64
      RETURN                                                                  65
    8 PRVTME = CTIME                                                          66
      N3 = KONVAR(6)                                                          67
      KTIME = KONVAR(2)                                                       68
      LAYER = KONVAR(4)                                                       69
      ITIME = KONVAR(1)                                                       70
      IF(GENRL(11))  13,  14,  13                                             71
   13 FTORIN = 12.0                                                           72
      GO TO 15                                                                73
   14 FTORIN = 1.                                                             74
   15 IF (KERR) 39, 20, 39                                                    75
   20 IF(KTIME -1) 25, 24, 25                                                 76
   24 FRSTM = GENRL(1)                                                        77
      KPAGE=0                                                                 78
   25 DO 30 I = 2,18,2                                                        79
      IJ = I                                                                  80
      IF(CTIME-OUTTB(I)) 33, 33, 30                                           81
   30 CONTINUE                                                                82
   33 IJ = IJ                                                                 83
      L = 0                                                                   84
      IF((CTIME-FRSTM) - OUTTB(IJ-1)) 350, 37, 37                             85
   37 FRSTM = CTIME                                                           86
      L=1                                                                     87
   39 WRITE (6,580) (HEAD(I) , I = 2,13)                                      88
      KPAGE=KPAGE+1                                                           89
      WRITE(6,501)KPAGE                                                       90
      WRITE(6,502) CTIME,DELTO(KTIME)                                         91
      WRITE(6,513)                                                            92
      IF(CHART(1)) 42, 40, 42                                                 93
   40 SCHAR(KTIME + 1) = 0.0                                                  94
   42 SC  = FTORIN * HTCONV(8)                                                95
      SPC = FTORIN * HTCONV(4)                                                96
      SM  = FTORIN * HTCONV(7)                                                97
      SPM = FTORIN * HTCONV(5)                                                98
      WRITE(6,503)  SC,SPC,SM,SPM,EMDG(1),                                    99
     1SPACVR(1),SPACVR(2),SPACVR(3)                                          100
      WRITE(6,514)                                                           101
      WRITE(6,504)(TIVAR(I),I=1,10)                                          102
   53 IF(OUTTB(19)) 57, 55, 57                                               103
   55 WRITE(6,515)                                                           104
      WRITE(6,505)(Q(KTIME+1,I),I=7,12),Q(4,13)                              105
   57 WRITE(6,516)                                                           106
      WRITE(6,505) (Q(KTIME+1,I),I = 1,6),Q(1,13),Q(2,13)                    107
      NXS = 1                                                                108
      XRAY(ITIME + 1) = 1.                                                   109
      NPSL1 = PTSIN(1) + 2.                                                  110
   62 DO 149 J = 1,LAYER                                                     111
      NPSI = PTSIN(J) + 2.                                                   112
      NXS = NXS + NPSI-1                                                     113
C     WRITE OUT THE HEADING FOR THE COORDINATES                              114
      JL1 = JLAYER(J) + 1                                                    115
      IF(JL1 - 1) 113, 112, 113                                              116
  112 JPLA = 0                                                               117
      GO TO 114                                                              118
  113 XRAY(JL1) = 0.0                                                        119
      JPLA = NXS-NPSI                                                        120
  114 JPLA1 = JPLA + 1                                                       121
      DO 115 I = JPLA1,NXS                                                   122
      K = I + 1                                                              123
      XRAY(K) = 0.0                                                          124
      IF(J-1) 2116,2115,2116                                                 125
 2115 XRAY(I) = FTORIN * ABS(XLOC(I) - TRAJV(50))                            126
      GO TO 115                                                              127
 2116 XRAY(I) = FTORIN * ABS (XLOC(I) - XLOC(JPLA1))                         128
  115 CONTINUE                                                               129
      IF(J-1) 116, 116, 121                                                  130
  116 XLAST = XRAY(NPSL1)                                                    131
  121 WRITE(6,563) J                                                         132
      NJL1 = JL1 + NPSI -1                                                   133
      WRITE(6,566)(XRAY(JJ),JJ = JL1,NJL1)                                   134
C     WRITE OUT HEADING FOR TEMPERATURES                                     135
      WRITE(6,565) J                                                         136
      IK = ITIME*N3+JLAYER(J) + 1                                            137
      KI=IK+NPSI-1                                                           138
      IF(J.EQ.1) JDS=IK                                                      139
      WRITE(6,566)(T(K),K = IK,KI)                                           140
      IF (J-1) 149, 126, 149                                                 141
  126 IF(CHART(1)) 127, 146, 127                                             142
C     WRITE OUT THE DENSITY AND HEADING IF DESIRED                           143
  127 WRITE(6,567) J                                                         144
      WRITE(6,566)(DENS(K),K=IK,KI)                                          145
  146 IF(KONVAR(7)-2) 149, 145, 149                                          146
  145 WRITE(6,568) J                                                         147
      WRITE(6,566)(P(K),K=IK,KI)                                             148
  149 CONTINUE                                                               149
      NPTS=NXS                                                               150
      JE=JDS+NPTS-1                                                          151
      IF(OUTTB(20)) 310, 200, 310                                            152
  200 NX = PTSIN(1) + 2.0                                                    153
      IKI = ITIME*N3 + 1                                                     154
      IT = IKI + ITIME                                                       155
      T(IT) = 1.                                                             156
      XXX=0.0                                                                157
      XRAY(NPSL1) = XLAST                                                    158
      NXM1 = NX - 1                                                          159
      DO 220 K = 1,NXM1                                                      160
      IF(XXX-XRAY(1)) 210,215,215                                            161
  210 TRAY(K)=0.0                                                            162
      GO TO 220                                                              163
  215 IF(K-NX) 216,222,222                                                   164
  216 IF(XXX-XRAY(NX)) 218, 218, 217                                         165
  217 CALL EXIT                                                              166
  218 CALL TABUP(XRAY,T(IKI),XXX,TRAY(K),ITIME,-1)                           167
  220 XXX = XXX + DELETA(1) * HTCONV(9) * FTORIN                             168
  222 LASTT = ITIME*N3 + NX                                                  169
      TRAY(NX)=T(LASTT)                                                      170
      WRITE(6,570)                                                           171
      WRITE(6,566)(TRAY(JKL),JKL=1,NX)                                       172
      WRITE(6,552)(COUNT(N),N = 1,18)                                        173
  310 IF(STVAR(1)) 315, 330, 315                                             174
  315 CALL MOMENT(XRAY)                                                      175
C****         TEST IF INEQUALITY HAS BEEN VIOLATED.                          176
  330 IF(AUS(3)) 335,340,340                                                 177
  335 WRITE(6,585)                                                           178
C****         RESET AUS(3) FOR OUTPUT.                                       179
      AUS(3) = -AUS(3)                                                       180
  340 WRITE(6,590)                                                           181
      WRITE(6,566) (AUS(JD),JD = 1,8)                                        182
      WRITE(6,600) IMEX                                                      183
C****          SEE IF A PLOTTING TAPE HAS BEEN REQUESTED.                    184
  350 IF(GENRL(13)) 400,400,360                                              185
C****          AT EFN 360 A TAPE FOR THE S.C.--4020 PLOTTING                 186
C****          ROUTINES HAS BEEN REQUESTED.                                  187
C****          THE TAPE FORMAT IS FORTRAN 4  BINARY.  THE FIRST RECORD       188
C****          IS WRITTEN ONCE AT THE START OF THE RUN-----FOLLOWING         189
C****          THIS AT EVERY NORMAL OUTPUT INTERVAL THERE WILL               190
C****          BE WRITTEN 1 RECORD OF INFORMATION.                           191
C****          THIS RECORD WILL CONTAIN ALL THE DATA NECESSARY FOR           192
C****          CONSTRUCTING ANY OF THE PLOTS NORMALLY REQUESTED.             193
  360 IF(L.EQ.0) GO TO 400                                                   194
      IF(KPAGE.GT.1) GO TO 380                                               195
C****          THIS IS THE SINGLE RECORD FOR THE FIRST TIME.                 196
  370 WRITE( 9) LAYER,GENRL(11),GENRL(1),GENRL(2),(THIKN(JD),JD=1,LAYER)     197
     1,(DENSE(JD),JD=1,LAYER)                                                198
C****          THIS IS FOR THE SUBSEQUENT DATA RECORDS.                      199
  380 WRITE( 9)  CTIME,Q(4,13),SM,SC,(Q(KTIME+1,JD),JD=1,6),Q(1,13),         200
     1Q(2,13),EMDG(1),NPTS,Q(KTIME+1,7),(PTSIN(JD),JD=1,LAYER),(XRAY(JD)     201
     1,JD=1,NPTS),(T(JD),JD=JDS,JE),(DENS(JD),JD=JDS,JE)                     202
      L = 0                                                                  203
  400 RETURN                                                                 204
  501 FORMAT(1H 112X,4HPAGEI3)                                               205
  502 FORMAT(10H     TIME=F14.8,13H  DELTA TIME=F13.8)                       206
  503 FORMAT(1X,8E12.4)                                                      207
  504 FORMAT(1X,5E12.4//)                                                    208
  505 FORMAT(1X,8E12.4)                                                      209
  513 FORMAT(1H0,2X,8HAMT CHAR,4X,9HRATE CHAR,3X,8HAMT MELT,4X,9HRATE ME     210
     1LT,4X,6HMDG(1),4X,6HAR1(1),6X,7HAR1P(1),5X,7HETA0(1)  )                211
  514 FORMAT(1H0,13X,31HTIME TABLE ENTRIES 1 THROUGH 10  )                   212
  515 FORMAT(85H0  INT QNET     INT QRR    INT QGHR     INT QC      INT      213
     1QBLK   INT QBKFAC    QI TOTAL)                                         214
  516 FORMAT(1H0,4X,5HQDNET,7X,4HQDRR,8X,4HQGHR,9X,2HQC,9X,5HQDBLK,9X,6H     215
     1QBKFAC,4X,4HQVAP,7X,4HQC *  )                                          216
  552 FORMAT(1H0,2X,8HCOUNT = 1P6E13.5/2(11X,1P6E13.5/))                     217
  554 FORMAT(4E15.8)                                                         218
  563 FORMAT(1H04X,10HCOORDINATE,1X,6HVALUES,3X,6HLAYER=I2)                  219
  565 FORMAT(1H04X,12HTEMPERATURES4X,6HLAYER=I3)                             220
  566 FORMAT(/(1PE16.5,7E14.5))                                              221
  567 FORMAT(1H04X,8HDENSITYS,8X,6HLAYER=I2)                                 222
  568 FORMAT(1H04X,13HGAS DENSITIES,6X,8HLAYER = I2)                         223
  570 FORMAT(1H04X,41HEQUALLY SPACED TEMPERATURES   FIRST LAYER)             224
  580 FORMAT(1H1,12A6)                                                       225
  585 FORMAT(1H0,4X,52H**********CONDITION VIOLATED RUN CONTINUED*******     226
     1***///)                                                                227
  590 FORMAT(1H0,4X,10HAUS  TABLE)                                           228
  600 FORMAT(1H0,10X,5H*****,2X,27HMETHOD OF COMPUTATION WAS  I2)            229
      STOP                                                                   230
      END                                                                    231
$IBFTC PBETA
      SUBROUTINE PBETA (III,MNI,JJJ,ITM)                                       1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       62
      DIMENSION GVAR(6)                                                       63
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           64
     1             (TRAJV(21),TABLD)                                          65
C                              THIS SUBROUTINE CALCULATES                     66
C                              BETA(1-4) FOR THE DIFFERENCE                   67
C                              EQUATIONS.                                     68
C                              SET UP COUNTERS                                69
      RBAR = GRAPH(8)/GRAPH(9)                                                70
      II = III                                                                71
      J = JJJ                                                                 72
      MN = MNI                                                                73
      GJ = 25051.6                                                            74
      KT = KONVAR(2)                                                          75
      TDN = 2.*DELETA(1)                                                      76
      IF(KT-1) 6, 5, 6                                                        77
    5 GRMU = GRAPH(8) *  32.2 / GRAPH(10) / GRAPH(9)                          78
      ALPH = .33333333                                                        79
    6 CTIME = CTIME                                                           80
      JJ = II-KONVAR(1)                                                       81
      TE = T(II)                                                              82
      RHOGP = P(II)                                                           83
      WDS = WDOTP(MN)                                                         84
C****         ETVGN HAS NOT BEEN DEFINED AS YET, SO THE VALUE IS ASSUMED      85
C****         TO BE ZERO                                                      86
      ETVGN = SCDTB(18)                                                       87
      CALL TABUP(WARM,PROPT,T(II),PROP,INDTL(4),-3)                           88
C****         THE ARRANGEMENT OF STORING HG, EC, EP IN PROPT(1-3)             89
C****         ALLOWS ONLY ONE LAYER TO BE USED)  LATER THIS WILL HAVE         90
C****         TO BE CHANGED.                                                  91
      HG = PROP(1)                                                            92
      EC = PROP(2)                                                            93
      EP = PROP(3)                                                            94
      EBAR = (EP-EC)/CHART(6)+EC                                              95
      DEL1 = (T(II) - T(II-1))/DELETA(1)                                      96
      DEL2 = (T(II+1) - T(II))/DELETA(1)                                      97
      IF (J-1) 200,10,200                                                     98
C****              CALL FOR K(EFF) AND RHO(CP)-EFF                            99
   10 CALL KEFFS(II,MN)                                                      100
      CALL RCPEFS(II,MN)                                                     101
      NPTS = PTSIN(1) + 2.                                                   102
   25 CALL DFINTC(DENS,II,MN,J,TPTFMR,SD)                                    103
      CALL DFINTC(P,II,MN,J,TPTFMI,RHOGNN)                                   104
      CALL DFINTC(P,JJ,MN,J,TPTFMJ,SD)                                       105
      CALL DFINTC(T,II,MN,J,TNFI,SDT)                                        106
      CALL DFINTC(T,JJ,MN,J,TNFJ,SD)                                         107
      RHON = TPTFMR/TDN                                                      108
      RHOGN = TPTFMI/TDN                                                     109
      TN = TNFI/TDN                                                          110
      TNN = SDT/DELETA**2                                                    111
      TNT = (TNFI-TNFJ)/TDN/DELTO(KT)                                        112
      RHOGNT = (TPTFMI-TPTFMJ)/TDN/DELTO(KT)                                 113
      RHOGNN = RHOGNN/DELETA(1)**2                                           114
   55 RHOGT = (P(II)-P(JJ))/DELTO(KT)                                        115
      TT = (T(II)-T(JJ))/DELTO(KT)                                           116
      RMBART = GRAPH(11)/GRAPH(9)                                            117
      RMBRTT = GRAPH(12)/GRAPH(9)                                            118
      RMBRSQ = RMBART ** 2                                                   119
C****         COMPUTE F TERMS                                                120
      F1 = -RMBART + ALPH/TE                                                 121
      F1T = -RMBRTT + RMBRSQ - ALPH/TE**2                                    122
      F2 = GRMU * TE ** ALPH                                                 123
      F1F2 = F1 * F2                                                         124
      RKN1 = RHOGN * TABLD(15)                                               125
      RKN2 = TABLD(16) * RHOGP                                               126
      RHOKN = RKN1 + RKN2                                                    127
      RKNN = RHOGNN * TABLD(15) + 2. * RHOGN * TABLD(16) + TABLD(19) *       128
     1 RHOGP                                                                 129
      ETATX =( ETASBT(MN+1) - ETASBT(MN-1))/2./DELETA(1)                     130
      RHOKT = T ABLD(15) * RHOGT + TABLD(18) * RHOGP                         131
      RKNT = TABLD(17)*RHOGP + TABLD(16)*RHOGT + TABLD(18)*RHOGN +           132
     1 TABLD(15)*RHOGNT                                                      133
C****         COMPUTE THE SET OF A TERMS.                                    134
      A1 = F1F2 * TABLD(15) * RHOGP                                          135
      A2 = F2 * ETASBX(MN) * RHOKN                                           136
      A1N = A1 * ETASBX(MN)                                                  137
      A1NTN = A1N*TN                                                         138
      A1TRM = A1NTN + 2.*A2                                                  139
      A3 = F1F2 * RHOKT + F1*A2*ETASBT(MN)/ETASBX(MN)                        140
      A4 = F2*(RKNN*ETASBX(MN)*ETASBT(MN) + RHOKN*ETATX +                    141
     1 ETASBX(MN)*RKNT)                                                      142
      A5 = F2*(RKNN*ETASBX(MN)**2 + RHOKN*ETAXX(MN))                         143
C****         COMPUTE BETA-S.                                                144
      BETA1 = (SCDTB(1) + RHOGP/GJ*A1*A2**2)/SCDTB(4)                        145
      BETA2 = SCDTB(2)/SCDTB(4)                                              146
      BETA3 = SCDTB(3)*RHON*ETASBX(MN)/SCDTB(4)                              147
C****         COMPUTE THE TERMS FOR BETA 4.                                  148
      B41A = -A2**2/2./GJ - HG-EBAR                                          149
      B41B = RHOGP * A2 * (A2*A5-A4)/GJ                                      150
      B41C = RBAR/778. * TE * (RHOGT + ETASBT(MN) * RHOGN )                  151
      B41 = WDS * B41A + B41B + B41C                                         152
      B42 = GRAPH(4)*RHOGP*ETASBX(MN)*(A1NTN + A2)                           153
      IF(B42) 70, 70, 75                                                     154
   70 TETA = DEL1                                                            155
      GO TO 80                                                               156
   75 TETA = DEL2                                                            157
   80 B42 = B42*TETA                                                         158
      B43 = -WDS*  A1N* A1TRM/2.                                             159
      IF(B43) 82, 82, 85                                                     160
   82 TETA = DEL1                                                            161
      GO TO 87                                                               162
   85 TETA = DEL2                                                            163
   87 B43 = B43 * TETA / GJ                                                  164
      B44 = RHOGP * A1N *  A5 * A1TRM                                        165
      IF(B44) 90, 90, 92                                                     166
   90 TETA = DEL1                                                            167
      GO TO 95                                                               168
   92 TETA = DEL2                                                            169
   95 B44 = B44 * TETA / GJ                                                  170
      B451 = RHOGP *  A2**2 * ETASBX(MN)                                     171
      B452 = 2. * A2 * F1                                                    172
      B453 = 4. * F1 + F1T + F1 ** 2                                         173
      B454 = A1 * TN * ETASBX(MN) / F1                                       174
      B45 = B451 * (B452 + B453 * B454)                                      175
      IF(B45) 97, 97, 99                                                     176
   97 TETA = DEL1                                                            177
      GO TO 100                                                              178
   99 TETA = DEL2                                                            179
  100 B45 = B45 * TETA / GJ                                                  180
      RA1N = RHOGP * ETASBX(MN) * A1 ** 2                                    181
      B461 = RA1N * ETASBX(MN) ** 2                                          182
      B462 = A1TRM-ETASBT(MN)/ ETASBX(MN)                                    183
      B46 = B461 * B462 * TNN                                                184
      IF(B46) 102, 102, 105                                                  185
  102 TETA = DEL1                                                            186
      GO TO 107                                                              187
  105 TETA = DEL2                                                            188
  107 B46 = B46 * TETA / GJ                                                  189
      B471 = RA1N * TN                                                       190
      B472 = A1TRM * ETAXX(MN) - ETATX * ETASBX(MN)                          191
      B47 = B471 * B472                                                      192
      IF(B47) 110, 110, 112                                                  193
  110 TETA = DEL1                                                            194
      GO TO 115                                                              195
  112 TETA = DEL2                                                            196
  115 B47 = B47 * TETA / GJ                                                  197
      B481 = -RHOGP * A3 * ETASBX(MN)                                        198
      B48 = B481 * (A1NTN + A2)                                              199
      IF(B48) 117, 117, 119                                                  200
  117 TETA = DEL1                                                            201
      GO TO 120                                                              202
  119 TETA = DEL2                                                            203
  120 B48 = B48 * TETA / GJ                                                  204
      B49 = -RHOGP * A1 * A4 * ETASBX(MN)                                    205
      IF(B49) 122, 122, 124                                                  206
  122 TETA = DEL1                                                            207
      GO TO 126                                                              208
  124 TETA = DEL2                                                            209
  126 B49 = B49 * TETA / GJ                                                  210
      B4101 = B461 * TN ** 2 / F1                                            211
      F1F1T = 2. * F1 ** 2 + F1T                                             212
      B4102 = 2. * A2 * F1F1T                                                213
      B4103 = A1 * (F1**2 + F1T) * ETASBX(MN) * TN                           214
      B410 = B4101 * (B4102 + B4103)                                         215
      IF(B410) 130, 130, 132                                                 216
  130 TETA = DEL1                                                            217
      GO TO 135                                                              218
  132 TETA = DEL2                                                            219
  135 B410 = B410 * TETA  / GJ                                               220
      B4111 = -RHOGP * A1 * A2 / F1                                          221
      B4112 = F1F1T * ETASBX(MN) * ETASBT(MN) * TN                           222
      B4113 = F1 * ETATX * ETASBX(MN)                                        223
      B4114 = - B471*ETASBX(MN) * ETASBT(MN)                                 224
      B411 = B4111 * (B4112 + B4113) + B4114                                 225
      IF(B411) 137, 137, 139                                                 226
  137 TETA = DEL1                                                            227
      GO TO 140                                                              228
  139 TETA = DEL2                                                            229
  140 B411 = B411 * TETA  / GJ                                               230
      B412 = -RHOGP * A1 * A2 * ETASBX(MN) * ET ASBT(MN) * TNN               231
      B412 = B412/GJ                                                         232
      B4131 = B4111 * ETASBX(MN)                                             233
      B4132 = B4131 * TN * TT                                                234
      B4133 = B4131 * F1                                                     235
      B4134 = B4133 * TNT                                                    236
      B4135 = - RHOGP * A1N**2 * TN * TNT                                    237
      B4136 = -RA1N * (2.*F1**2 + F1T) * TN * ETASBT(MN)/F1                  238
      IF(B4136) 150,150,152                                                  239
  150 TETA = DEL1                                                            240
      GO TO 154                                                              241
  152 TETA = DEL2                                                            242
  154 B4136 = B4136 * TETA                                                   243
      B413 = B4132 + B4134 + B4135  + B4136                                  244
      B413 = B413/GJ                                                         245
      B414 = ETVGN * ET ASBX(MN)                                             246
      BETA4 = (B41 + B42 + B43+ B44 + B45 + B46 + B47 + B48 + B49 +          247
     1 B410 + B411 + B412 + B413 + B414) / SCDTB(4)                          248
      EX = ETASBX(MN)                                                        249
      EXX = ETAXX(MN)                                                        250
      ET = ETASBT(MN)                                                        251
      GO TO 301                                                              252
  200 DEN1 = DENSE(J)                                                        253
      NPTS = PTSIN(J) + 1.                                                   254
C                              CALCULATE BETA(1-4)                           255
C                       TABLE LOOK-UP FOR CK,DK/DT,CP,                       256
  201 MN1 = (INDTL(4)+1)*(J-1)*3+1                                           257
      CALL TABUP(WARM,PROPT(MN1),TE,PROP,INDTL(4),-3)                        258
      SS = PROP(1)                                                           259
      CK = PROP(2)                                                           260
      DKDTUP = PROP(3)                                                       261
      BETA1 = CHARV(1)*CK/(DEN1*SS*CHARV(3))                                 262
      BETA2 = BETA1*DKDTUP/CK                                                263
  206 EX = 1./THIKN(J)                                                       264
      EXX = 0.0                                                              265
      ET = 0.0                                                               266
  301 ETAXSQ = EX**2                                                         267
      BETA(1,MN) = BETA1*ETAXSQ                                              268
      BETA(2,MN) = BETA2*ETAXSQ                                              269
      BETA(3,MN) = BETA3*EX-ET+BETA1*EXX                                     270
      BETA(4,MN) = BETA4                                                     271
      TIVAR(10) = AMAX1(ABS(BETA(2,MN)*DENS(II)),ABS(BETA(4,MN)),            272
     1  TIVAR(10))                                                           273
C                              TEST QUANTITIES TO CHECK                      274
C                              IF ITERATION IS NECESSARY                     275
C                              IN INTPTS                                     276
      IF (CHART(1)) 375,304,375                                              277
  304 IF (BETA2) 375,305,375                                                 278
  305 IF (ABS(WDOTP(MN))) 310,315,310                                        279
  310 IF (ABS(CG)+ABS(GVAR(1))) 375,315,375                                  280
  315 NT1 = INDTL(4)+1                                                       281
      J1 = (J-1)*NT1*3+NT1                                                   282
      IF(ABS(PROPT(J1))) 375,380,375                                         283
  375 ITTEMP = 1                                                             284
C                       ITTEMP = 1 MEANS ITERATION IN MIDPTS.                285
      GO TO 400                                                              286
  380 ITTEMP = 0                                                             287
C                       ITTEMP = 0. MEANS NO ITERATION IN MIDPTS.            288
  400 ITM = ITTEMP                                                           289
  501 RETURN                                                                 290
      END                                                                    291
$IBFTC PEMDG
      SUBROUTINE PEMDG(KI)                                                     1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       62
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           63
     1             (TRAJV(21),TABLD)                                          64
      K2 = KI                                                                 65
    1 K1 = KONVAR(6)*KONVAR(1)                                                66
      NPTS = PTSIN(1)+1.                                                      67
      EMDG(NPTS+1) = 0.                                                       68
      IF (K2) 3,11,3                                                          69
    3 NPTS = 1                                                                70
      K = K2-K1                                                               71
      GO TO 21                                                                72
   11 K = 1                                                                   73
   21 DO 107 I1 = 1,NPTS                                                      74
      N = (NPTS-I1+1)*K                                                       75
      I = N+K1                                                                76
      IF (N) 45,45,50                                                         77
   45 N = I                                                                   78
   50 IF(K2) 51, 53, 51                                                       79
   51 IF(K-1) 54, 53, 54                                                      80
   53 CALL DEE(I,N)                                                           81
   54 IF( N-1) 65,55,65                                                       82
   55 RETA = (-3.*P(I) + 4.*P(I+1) - P(I+2))/2./DELETA(1)                     83
      GO TO 70                                                                84
   65 RETA = (P(I+1)-P(I-1))/2./DELETA(1)                                     85
   70 VG = -(TABLD(2)*P(I) + 3.*TABLD(1)*ETASBX(N)*RETA)/3.                   86
      EMDG(N) =-P(I)*VG                                                       87
  107 CONTINUE                                                                88
  202 RETURN                                                                  89
      END                                                                     90
$IBFTC PHI
      SUBROUTINE PHI(III,MNI)                                                  1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       62
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           63
     1             (TRAJV(21),TABLD)                                          64
      II = III                                                                65
      MN = MNI                                                                66
      CTIME = CTIME                                                           67
      JJ = II - KONVAR(1)                                                     68
      KT = KONVAR(2)                                                          69
      J = 1                                                                   70
      CALL DFINTC(T,II,MN,J,TNP,TNNP)                                         71
      CALL DFINTC(T,JJ,MN,J,TNPJ,TNNPJ)                                       72
      TN = TNP/2./DELETA(1)                                                   73
      TNT = (TNP-TNPJ)/2./DELETA(1)/DELTO(KT)                                 74
      TNN = TNNP/DELETA(1)**2                                                 75
      TT = (T(II)-T(JJ))/DELTO(KT)                                            76
      C = GRAPH(8)*32.2/GRAPH(10)/GRAPH(9)                                    77
      PHI1 =  C  * T(II) ** .33333333                                         78
      PHI1N = PHI1* TN/3./T(II)                                               79
      PHI1T = PHI1* TT/3./T(II)                                               80
      PHI1NN = PHI1 * (3. * T(II)* TNT - 2. * TN * TT)/9./T(II)**2            81
      PHI1NT = PHI1 * (3. *T(II) * TNN - 2. * TN ** 2)/9./T(II) ** 2          82
      SCDTB(6) = PHI1                                                         83
      SCDTB(7) = PHI1N                                                        84
      SCDTB(8) = PHI1NN                                                       85
      SCDTB(9) = PHI1NT                                                       86
      SCDTB(10) = PHI1T                                                       87
  300 RETURN                                                                  88
      END                                                                     89
$IBFTC PRESSM
      SUBROUTINE PRESSM(III,JJJ,N,KKK)                                         1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
                                                                              62
                                                                              63
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       64
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           65
     1             (TRAJV(21),TABLD)                                          66
      II = III                                                                67
      JJ = JJJ                                                                68
      MN = II - KONVAR(6)*KONVAR(1)                                           69
      K = KKK                                                                 70
      IF(MN) 10, 15, 15                                                       71
   10 MN = 0                                                                  72
   15 CALL DPRESS(II,MN,K)                                                    73
      RETURN                                                                  74
      END                                                                     75
$IBFTC QBLK
      SUBROUTINE QBLK(QC,DHRHW,QBLOCK,EMV)                                     1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATIONS ARE DEFINED AND DISCUSSED IN SECTION II.C         62
      IF ( CHART(1) ) 1, 100, 1                                               63
    1 QDC = QC                                                                64
      HRHWD = DHRHW                                                           65
      EMDOT = EMV                                                             66
      II = KONVAR(6) * KONVAR(1) + 1                                          67
      IF ( HRHWD ) 2, 3, 2                                                    68
    2 IF(QDC) 4, 3, 4                                                         69
    3 QBL = 0.0                                                               70
      GO TO 98                                                                71
    4 QCDH = QDC/HRHWD                                                        72
      IF(ABS(CHART(4))-CTIME) 7,7,5                                           73
C****              IF CHART(4) IS MINUS, THEN WE HAVE POWERED FLIGHT,         74
C****                   SO TURBULENT COMES BEFORE LAMINAR.                    75
    5 IF(CHART(4)) 50, 50, 10                                                 76
C****              IF CHART(4) IS PLUS, THEN WE HAVE RE-ENTRY,                77
C****                   SO LAMINAR COMES BEFORE TURBULENT.                    78
    7 IF(CHART(4)) 10, 50, 50                                                 79
C****              LAMINAR BLOCKING ACTION STARTS AT EFN 10.                  80
   10 EXPONL = .33333333                                                      81
      TERM = 0.69*(CHART(9)**EXPONL)*EMDOT/QCDH/(CHART(10)**EXPONL)           82
      IF(TERM - .8) 30, 30, 20                                                83
   20 TERM = .8                                                               84
   30 QBL = QDC*TERM                                                          85
C****              TURBULENT BLOCKING ACTION STARTS AT EFN 50.                86
      GO TO 98                                                                87
   50 EXPONT = -.38*CHART(11)*EMDOT/QCDH                                      88
      QBL = QDC*(1. - EXP(EXPONT))                                            89
   98 QBLOCK = QBL                                                            90
  100 RETURN                                                                  91
      END                                                                     92
$IBFTC RCPEFS
      SUBROUTINE RCPEFS(III,MNI)                                               1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       62
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           63
     1             (TRAJV(21),TABLD)                                          64
      II = III                                                                65
C****              THIS ROUTINE COMPUTES RHO-CP-EFF                           66
C****                AND STORES IT IN SCDTB(4).                               67
      MN = MNI                                                                68
      CV = (GRAPH(5)-GRAPH(6))/CHART(6)                                       69
      ALPH = .33333333                                                        70
      RBAR = GRAPH(8)/GRAPH(9)                                                71
      F1 = -GRAPH(11)/GRAPH(9) + ALPH/T(II)                                   72
      RHOKN = TABLD(16) * P(II) + TABLD(15) *(P(II+1) - P(II-1))/2. /         73
     1DELETA(1)                                                               74
      A2 = 32.2 * RBAR / GRAPH(10) * T(II) ** ALPH * ETASBX(MN) * RHOKN       75
      TRM1 = P(II)*GRAPH(4)                                                   76
      TRM2 = DENS(II)*(CV + GRAPH(6))                                         77
      TRM3 = -CV*TABLD(14)                                                    78
      TRM4 = P(II)/778.*((A2**2*F1)/32.2-RBAR*(.66666667+T(II) * F1))         79
      SCDTB(4) = TRM1 + TRM2 + TRM3 + TRM4                                    80
      IF(SCDTB(4)) 198, 199, 199                                              81
  198 CALL ERROR(3,13HR-CP-EFF IS -  )                                        82
  199 RETURN                                                                  83
      END                                                                     84
$IBFTC RHOFFC
      SUBROUTINE RHOFFC(N,M,IM)                                                1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       62
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           63
     1             (TRAJV(21),TABLD)                                          64
                                                                              65
      IMP = IM                                                                66
      KN = N                                                                  67
      KM = M                                                                  68
C****              KN IS THE SAME AS II.                                      69
C****              KM IS THE SAME AS MN.                                      70
C****              COMPUTE CONTROL FOR COMPUTED GO TO BY ADDING 2             71
C****                   TO INPUT NUMBER IMP.                                  72
      KIMP = IMP + 2                                                          73
      GO TO (100, 200, 300), KIMP                                             74
C****              FRONT FACE GAS DENSITY CALLED FROM STARTT.                 75
  100 RCFP = CHART(8)*(1.-CHART(5))                                           76
      RCP = (RCFP+(CHART(6)-1.)*DENS(KN))/CHART(6)                            77
      RPP = DENS(KN) - RCP                                                    78
      EMM = 1.-RCP/CHART(8)-RPP/CHART(13)                                     79
      CALL TABUP(HORA,TTABL,CTIME,TIVAR(4),INDTL(5),4)                        80
      P(KN) = EMM*TIVAR(4)*GRAPH(9)/GRAPH(8)/T(KN)                            81
      GO TO 998                                                               82
C****              FRONT FACE DENSITY OF GAS CALLED FROM PTX1.                83
  200 GO TO 100                                                               84
C****              BACK FACE RHO-G CALLED FROM INTFC.                         85
  300 P(KN) = (4.*P(KN-1)-P(KN-2))/3.                                         86
  998 RETURN                                                                  87
      END                                                                     88
$IBFTC RITER
      SUBROUTINE RITER(KON)                                                    1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C                       THIS ROUTINE SETS UP THE                              62
C                       SPACING OF THE POINTS ALONG                           63
C                       THE X AXIS.                                           64
C****              KLOG = 1, COMPUTE THE R VALUES,THE X VALUES, AND           65
C****                   THE ETA DERIVATIVES.                                  66
C****              KLOG = 2, COMPUTE THE R VALUES.                            67
C****             KLOG = 3, COMPUTE THE X VALUES AND THE ETA DERIVATIVES      68
      KLOG = KON                                                              69
      CTIME = CTIME                                                           70
      LAYER = KONVAR(4)                                                       71
      ITIME = KONVAR(1)                                                       72
      GO TO (800, 800, 1000),KLOG                                             73
  800 STOPT = GENRL(2)                                                        74
      IF (SPACE(1)) 120,110,120                                               75
C                       INITIALIZE SPACING.                                   76
  110 ETAO = 1.0                                                              77
      AR = 0.0                                                                78
      ARP = 0.0                                                               79
      GO TO 246                                                               80
  120 IF (KONVAR(2)-1) 129,121,129                                            81
C                       FIRST TIME THROUGH THE ROUTINE.                       82
C                       BLOCK FOR INITIALIZATION FOR                          83
C                       FIRST TIME STEP.                                      84
  121 IF(SPACE(3)) 1121, 124, 1121                                            85
 1121 ETAMAX = AMAX1(SPACE(2),SPACE(3),SPACE(4))                              86
      DO 122 I=2,4                                                            87
      IF(ETAMAX-SPACE(I)) 122,123,122                                         88
  122 CONTINUE                                                                89
  123 XI=I-1                                                                  90
      XJ1=7.-8.*XI+2.*XI**2                                                   91
      XJ2=5.-5.*XI+XI**2                                                      92
      XJ3=22.-27.*XI+7.*XI**2                                                 93
      J4=XJ2+2.                                                               94
      J5=4.-XJ2-XI                                                            95
      XJ5=J5                                                                  96
      XK1=ALOG(ETAMAX/SPACE(J4+1))                                            97
      XK2=ALOG(ETAMAX/SPACE(J5+1))                                            98
      AA=ETAMAX                                                               99
      IF(XK1*XK2) 125,126,127                                                100
  125 CALL ERROR (4,22H PRODUCT K1,K2 IS NEG.)                               101
  126 FPRIME = 0.                                                            102
      XK6 = 1.                                                               103
      XK4=1.                                                                 104
      GO TO 129                                                              105
  124 ETAO = SPACE(2)                                                        106
      BB = 0.                                                                107
      EFE = 1.0                                                              108
      GO TO 131                                                              109
  127 XK3=SQRT(XK2/XK1)                                                      110
      BB=4.*XK1                                                              111
      TAUBAR=1.-XJ2*SQRT(1.-XJ1*XK3)                                         112
      XK4=(-XJ1*TAUBAR+XJ3/2.)/((XJ5-2.)*TAUBAR+XJ1)*STOPT/(STOPT-SPACE(     113
     15))                                                                    114
      FPRIME=(1.+XJ1)*TAUBAR/2.+(1.-XJ1)+(XJ2-1.)*XK4/2.                     115
      XK6 = (1.-XJ2)/2.*XK4*SPACE(5)                                         116
C                       END OF INITIALIZATION BLOCK.                         117
C                       COMPUTE F,TAU,AND ETAO(1).                           118
  129 IF(SPACE(3)) 130, 246, 130                                             119
  130 EFE = FPRIME*CTIME+XK6                                                 120
      TAU = EFE/((1.-XK4)*CTIME+XK4*SPACE(5))                                121
      ETAO = AA*EXP(-BB*(TAU*(1.-TAU/2.))**2)                                122
  131 IF (ETAO) 138,144,144                                                  123
  138 CALL ERROR (3,18H ETAO IS NEGATIVE    )                                124
C****              END OF ETAO BLOCK.                                        125
C****              BLOCK FOR ITERATION ON AR.                                126
  144 IF (ETAO-1.) 155,180,146                                               127
  146 AR = ETAO                                                              128
  148 RI = ETAO*(1.-EXP(-AR))                                                129
      IF (ABS(AR-RI)-.0005) 225,225,150                                      130
  150 AR = RI                                                                131
      GO TO 148                                                              132
  155 C1 = -ETAO*(1.+(2.*(2.-EXP(ETAO))) /((EXP(ETAO) -1.)**2))              133
      IF ((-2.*ETAO)-C1) 157,159,159                                         134
  157 AR = -2.*ETAO                                                          135
      GO TO 160                                                              136
  159 AR = C1                                                                137
  160 RI = -ALOG(1.-AR/ETAO)                                                 138
      IF (ABS(AR-RI)-.0005) 225,225,161                                      139
  161 AR = RI                                                                140
      GO TO 160                                                              141
  180 AR = 0.                                                                142
C****              END OF AR BLOCK.                                          143
C****              BLOCK TO COMPUTE ARP.                                     144
  225 IF (AR) 232,227,232                                                    145
  227 FSUBR = 2.                                                             146
      GO TO 240                                                              147
  232 FSUBR = AR/(1.0-ETAO+AR)                                               148
      IF (EFE) 240,235,240                                                   149
  235 ARP = 0.0                                                              150
      GO TO 246                                                              151
  240 TRMATA = -BB*TAU*(TAU-1.)*(TAU-2.)*TAU*(FPRIME-TAU*(1.-XK4))/EFE       152
  245 ARP = FSUBR*TRMATA                                                     153
C****              NEW TRANSFORMATION                                        154
  246 SPACVR(1) = AR                                                         155
      SPACVR(2) = ARP                                                        156
      SPACVR(3) = ETAO                                                       157
C****              END OF ARP BLOCK.                                         158
      GO TO (1000, 600, 1000),KLOG                                           159
 1000 DO 599 J = 1,LAYER                                                     160
      NPTS = PTSIN(J)+2.                                                     161
      IF(J-1) 247, 247, 248                                                  162
  247 N1 = 1                                                                 163
      GO TO 249                                                              164
  248 N1 = 2                                                                 165
  249 DO 598 I = N1,NPTS                                                     166
      K = 0                                                                  167
      MN = JLAYER(J)+I                                                       168
      EI = I-1                                                               169
      ETAI = EI*DELETA(J)                                                    170
      IF( I - NPTS) 1248, 1247, 1248                                         171
 1247 SQUIGL = 1.0                                                           172
      IF(J-1) 265, 265, 560                                                  173
 1248 IF(J-1) 600, 1249, 560                                                 174
 1249 IF(AR) 260, 250, 260                                                   175
  250 SQUIGL = ETAI                                                          176
      GO TO 265                                                              177
  260 SQUIGL = ALOG((1.-ETAI)+ETAI*EXP(-AR))                                 178
      SQUIGL = SQUIGL/(-AR)                                                  179
C****         IF ( C .GT. 8 ) CALL ERROR MESSAGE AT 390                      180
  265 IF(SPACE(6) - 8.) 267, 390, 390                                        181
  267 IF(SPACE(6)) 280, 270, 280                                             182
  270 XBAR = SQUIGL                                                          183
      GO TO 400                                                              184
  280 SQSTR = .5*EXP(-SPACE(6)/4.)                                           185
      IF (SQUIGL-SQSTR) 290,285,300                                          186
  285 XBAR = .5                                                              187
      GO TO 400                                                              188
  290 X = SQUIGL                                                             189
  293 X1 = SQUIGL*EXP(SPACE(6)*X*(1.-X))                                     190
      IF(ABS(X1-X)-.0005*X) 297, 297, 295                                    191
  295 X = X1                                                                 192
      K = K + 1                                                              193
      IF(K-100) 293,293,296                                                  194
  296 CALL ERROR(6,32H NO CONVERGENCE IN RITER EFN 293  )                    195
  297 XBAR = X1                                                              196
      GO TO 400                                                              197
  300 IF(SPACE(6) -2.) 320, 320, 301                                         198
  301 ARG1 = SQUIGL * EXP( SPACE(6) / 4. )                                   199
      X = AMIN1(ARG1,1.)                                                     200
  303 FX = SQUIGL*EXP(SPACE(6)*X*(1.-X))                                     201
      FP = SPACE(6)*(1.-2.*X)*FX                                             202
      X1 = (FX-X*FP)/(1.-FP)                                                 203
      IF(ABS(X1-X)-.0005*X) 310, 310, 305                                    204
  305 X = X1                                                                 205
      K = K + 1                                                              206
      IF( K-100) 303, 303, 306                                               207
  306 CALL ERROR(6,32H NO CONVERGENCE IN RITER EFN 303  )                    208
  310 XBAR = X1                                                              209
      GO TO 400                                                              210
  320 X  = (1. + SQRT(2./SPACE(6)))/2.                                       211
  322 FX = SQUIGL * EXP(SPACE(6) * X * (1.-X))                               212
      X1 = (FX + 4. * X) / 5.                                                213
      IF(ABS(X1-X) - .0005 * X) 310, 310, 325                                214
  325 X = X1                                                                 215
      K = K + 1                                                              216
      IF(K - 100) 322, 322, 336                                              217
  336 CALL ERROR(6,32H NO CONVERGENCE IN RITER EFN 336  )                    218
  390 CALL ERROR(5,27H SPACE(6) IS GREATER THAN 8  )                         219
  400 XLOC(MN) = THIKN(J)*XBAR+HTCONV(7)                                     220
      IF (MN-1) 410,405,410                                                  221
  405 ETASBX(MN) = ETAO/THIKN(J)                                             222
      ETAXO = ETAO/THIKN(J)                                                  223
  410 TSQXB = 1. + SPACE(6)*XBAR*(2.*XBAR-1.)                                224
      IF(XBAR) 420, 415, 420                                                 225
  415 SQXB = TSQXB                                                           226
      GO TO 425                                                              227
  420 SQXB = SQUIGL*TSQXB/XBAR                                               228
  425 ETASBX(MN) = ETAXO*((1.-ETAI)+ETAI*EXP(-AR))*SQXB                      229
C****              SECTION TO COMPUTE 2ND PARTIAL OF ETA                     230
C****                   WITH RESPECT TO X.                                   231
      SXX = SPACE(6)*((6.*XBAR-2.)+SPACE(6)*XBAR*(2.*XBAR-1.)**2)            232
      SXXDSX = SXX/TSQXB                                                     233
      ETAXX(MN) = ETASBX(MN)*(-AR*SQXB+SXXDSX)/THIKN(J)                      234
      GO TO 598                                                              235
  560 NPTS1 = JLAYER(J) + 1                                                  236
      XLOC(MN) = THIKN(J)*ETAI + XLOC(NPTS1)                                 237
      ETASBX(MN) = 1./THIKN(J)                                               238
      ETAXX(MN) = 0.0                                                        239
  598 CONTINUE                                                               240
  599 CONTINUE                                                               241
  600 DO 640 J = 1,LAYER                                                     242
      J1 = J+1                                                               243
      NPTS = PTSIN(J) + 2.                                                   244
      IF(J-1)  612,612,615                                                   245
  612 N1 = 1                                                                 246
      GO TO 617                                                              247
  615 N1 = 2                                                                 248
  617 DO 630 I= N1,NPTS                                                      249
      MN = JLAYER(J) +I                                                      250
      CALL COORD(MN,J1)                                                      251
  630 CONTINUE                                                               252
  640 CONTINUE                                                               253
  652 RETURN                                                                 254
      END                                                                    255
$IBFTC TABUP
      SUBROUTINE TABUP(TABIND,TABDEP,VARIND,VARDEP,NENTRY,KIN)                 1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C                    THIS SUBROUTINE PERFORMS A TABLE LOOK'UP                 62
C                    ON ANY ONE OR ANY NUMBER OF TABLES IN A GIVEN ARRAY      63
C                    EXPLANATION OF CALLING SEQUENCE                          64
C                    TABIND IS THE INDEPENDENT TABLE ARRAY                    65
C                    TABDEP IS THE DEPENDENT TABLE ARRAY                      66
C                    VARIND IS THE INDEPENDENT VARIABLE                       67
C                    VARDEP WILL CONTAIN THE ANSWER OR ANSWERS                68
C                    RESULTING FROM THE TABLE LOOK'UP                         69
C                    NENTRY CONTAINS THE NUMBER OF VALUES IN THE TABLE        70
C                    KIN IS THE CONTROL FOR THE NUMBER                        71
C                    OF TABLE LOOK'UPS                                        72
C                    A NEGATIVE SIGN MAY MEAN MORE THAN ONE TABLE             73
C                    LOOK'UP.  NUMERICAL VALUE OF KIN WILL GIVE THE           74
C                    NUMBER OF TABLES GOING FROM THE FIRST                    75
C                    ON WHICH TO PERFORM A TABLE LOOK'UP                      76
C                    A POSITIVE SIGN MEANS ONE TABLE LOOK'UP AND THE          77
C                    NUMERICAL VALUE OF KIN WILL GIVE WHICH                   78
C                    TABLE IN THE ARRAY THAT IS TO BE USED                    79
      DIMENSION VARDEP(1),TABIND(1),TABDEP(1)                                 80
      KAY=KIN                                                                 81
C                    TEST FOR NUMBER OF TABLE LOOK'UPS                        82
      IF(KAY) 1,6,2                                                           83
C                    MORE THAN ONE TABLE LOOK'UP DESIRED                      84
    1 LL=-KAY                                                                 85
      KAY=1                                                                   86
      GO TO 3                                                                 87
C                    ONLY ONE TABLE LOOK'UP                                   88
    2 LL=1                                                                    89
C                    TEST IF BELOW TABLE RANGE                                90
    3 IF(VARIND-TABIND(1)) 5,4,7                                              91
C                    EXACT VALUE                                              92
    4 JC=1                                                                    93
      GO TO 9                                                                 94
    5 CALL ERROR(5, 30H  TABLE LOOK'UP OUT OF RANGE   )                       95
    6 CALL ERROR(5, 25H  KIN HAS A ZERO ARGUMENT )                            96
    7 DO 8 JC=2,NENTRY                                                        97
      JC=JC                                                                   98
C                    FIND LOCATION OF VARIABLE IN THE                         99
C                    INDEPENDENT TABLE                                       100
      IF(VARIND-TABIND(JC)) 10,9,8                                           101
    8 CONTINUE                                                               102
      GO TO 5                                                                103
    9 MM=1                                                                   104
      GO TO 11                                                               105
C                    INTERPOLATION NECESSARY                                 106
   10 MM=2                                                                   107
   11 DO 16 J=1,LL                                                           108
      LLL=(NENTRY+1)*J*KAY                                                   109
C                    TEST IF TABLE IS CONSTANT                               110
      IF(TABDEP(LLL)) 13,12,13                                               111
C                    CONSTANT TABLE                                          112
   12 VARDEP(J)=TABDEP(LLL-1)                                                113
      GO TO 16                                                               114
C                    N IS SUBSCRIPT TO LOCATE TABLE                          115
   13 N=(1+NENTRY)*(KAY*J-1)+JC                                              116
      GO TO (14,15),MM                                                       117
C                    EXACT VALUE                                             118
   14 VARDEP(J)=TABDEP(N)                                                    119
      GO TO 16                                                               120
C                    INTERPOLATION ROUTINE                                   121
   15 M=N-1                                                                  122
      DIV=TABIND(JC)-TABIND(JC-1)                                            123
      TERM1=VARIND*(TABDEP(N)-TABDEP(M))                                     124
      TERM2=TABIND(JC)*TABDEP(M)-TABIND(JC-1)*TABDEP(N)                      125
      VARDEP(J)=(TERM1+TERM2)/DIV                                            126
   16 CONTINUE                                                               127
   20 RETURN                                                                 128
      END                                                                    129
$IBFTC TNEST
      SUBROUTINE TNEST(TNEW,OUT,EPSS1)                                         1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATIONS IN THIS ROUTINE ARE DEFINED AND DISCUSSED         62
C****         IN APPENDIX C                                                   63
      DIMENSION ITCNT(10), J1(10),L(10),T1(10), T2(10), T3(10), TAVG(10)      64
      DIMENSION OVALIN(10), OVALOT(10)                                        65
C                  TNEW IS THE NEW GUESS AND OUTPUTOF THE ROUTINE.            66
C                  TNINT IS THE NEW GUESS (INTERNAL TO THE ROUTINE).          67
C                  TGUESS IS THE LATEST GUESS.                                68
      EPSS = EPSS1                                                            69
C                  FIRST TIME THROUGH,  OUT1 IS INITIAL GUESS.                70
      OUTI = OUT                                                              71
      TGUESS = TNEW                                                           72
C                  J1(N) = 1       NORMAL OPERATION.                          73
C                  J1(N) = 2       ITERATIVE OPERATION TO GET                 74
C                       INFORMATION,  BECAUSE OF NON-CONVERGENCE.             75
      J1N = J1(N)                                                             76
      IF(EPSS) 1,108,2                                                        77
C                       IF EPSS =                                             78
C                       -  IT IS THE FIRST TIME THROUGH.                      79
C                       0. IT IS INITIALIZATION.                              80
C                       + 2 OR 3 POINTS ARE IN CORE                           81
C                       SO INTERPOLATION AND NESTING CAN BE DONE.             82
    1 N = N+1                                                                 83
      IF(N-10) 600, 600, 106                                                  84
  600 OVALIN(N) = OUTI                                                        85
      OVALOT(N) = TNEW                                                        86
      L(N) = 1                                                                87
      OUTI = 2.01                                                             88
      ITCNT(N) = 0                                                            89
      TNINT = TGUESS                                                          90
      T1(N) = OVALIN(N)                                                       91
      T2(N) = TGUESS                                                          92
      IF(ABS(T1(N)-T2(N))-ABS(EPSS*T2(N))) 105, 105, 110                      93
C     SECOND TIME THROUGH                                                     94
    2 N = N                                                                   95
      LL = L(N)                                                               96
C                  L(N) = 1        FUNCTION IS MONOTONIC.                     97
C                  L(N) = 2        FUNCTION IS NON-MONOTONIC.                 98
      GO TO (3,42),LL                                                         99
    3 T3(N) = TGUESS                                                         100
C                       TEST FOR CONVERGENCE                                 101
      IF(ABS(T2(N)-T3(N))-ABS(EPSS*T2(N))) 105, 105, 6                       102
    6 TMAX =AMAX1(T1(N),T2(N),T3(N))                                         103
      TMIN =AMIN1(T1(N),T2(N),T3(N))                                         104
C                  TMAX IS THE MAXIMUM OF THE 3 GUESSES.                     105
C                  TMIN IS THE MINIMUM OF THE 3 GUESSES.                     106
C                       TEST IF MONOTONE                                     107
      IF(T1(N)- TMAX)  30, 27, 30                                            108
   27 IF(T3(N)- TMIN)  37,35,37                                              109
   30 IF(T1(N)- TMIN ) 37,32,37                                              110
   32 IF(T3(N)- TMAX ) 37,35,37                                              111
C                       NUMBERS ARE MONOTONIC                                112
C                  T1(N), T2(N), T3(N)  ARE CONSECUTIVE GUESSES              113
C                       IN MONOTONIC ITERATION.                              114
   35 T1(N) = T2(N)                                                          115
      T2(N) = T3(N)                                                          116
      TNINT = T2(N)                                                          117
C                       NO CONVERGENCE, SO SET ITERATION INDICATOR           118
      OUTI = 2.01                                                            119
      GO TO 88                                                               120
C                       NON-MONOTONIC OR NESTING                             121
   37 T1(N) = TMIN                                                           122
      T2(N) = TMAX                                                           123
C                  TAVG(N) IS THE AVERAGE OF T1(N) AND T2(N).                124
C                       IN NESTING ITERATION,  NEXT GUESS.                   125
   38 TAVG(N)  = (T1(N) + T2(N))/2.0                                         126
      TNINT = TAVG(N)                                                        127
      L(N) = 2                                                               128
C                       NO CONVERGENCE, SO SET ITERATION INDICATOR           129
      OUTI = 2.01                                                            130
      GO TO 88                                                               131
C                       NON-MONTONIC OR NESTING                              132
   42 IF(ABS(TAVG(N)-TGUESS)-ABS(EPSS*TAVG(N))) 105,105,43                   133
   43 IF(TAVG(N)-TGUESS) 44,44,46                                            134
C                  T1(N), T2(N)  ARE THE BOUNDS IN THE                       135
C                       NON-MONOTONIC ITERATION.                             136
   44 T1(N) = TAVG(N)                                                        137
      GO TO 38                                                               138
   46 T2(N) = TAVG(N)                                                        139
      GO TO 38                                                               140
C                       ITERATION TEST AND FINIS                             141
   88 ITCNT(N) = ITCNT(N) + 1                                                142
   95 IF(ITCNT(N)-50) 110,110,99                                             143
   99 J1N = J1N                                                              144
      GO TO (100,200),J1N                                                    145
  100 J1(N) = 2                                                              146
      WRITE(6,500)                                                           147
  112 OUTI = 3.01                                                            148
      TNEW = OVALOT(N)                                                       149
      T1(N) = OVALIN(N)                                                      150
      T2(N) = OVALOT(N)                                                      151
      WRITE(6,506) T1(N),T2(N)                                               152
      L(N) = 1                                                               153
      GO TO 115                                                              154
  200 WRITE(6,501) N, L(N), TGUESS, TNINT, T1(N), T2(N), T3(N), TAVG(N),     155
     1TMAX, TMIN                                                             156
      IF(ITCNT(N) - 66) 201, 205, 205                                        157
  201 OUTI = 3.01                                                            158
      GO TO 110                                                              159
  205 CALL ERROR(6,36H 15 RETRIES COMPLETED. PDUMP FOLLOWS  )                160
C                       CONVERGED, SO SET INDICATOR                          161
  105 OUTI = 1.01                                                            162
      TNINT = TGUESS                                                         163
      TAVG(N) = 0.                                                           164
      J1(N) = 1                                                              165
      N = N-1                                                                166
      IF(N) 106, 110, 110                                                    167
  106 WRITE(6,505) N                                                         168
      CALL ERROR(5,30H INIT. OF EPSILON IS INCORRECT  )                      169
  108 DO 109 I=1,90                                                          170
  109 ITCNT(I) = 0                                                           171
      EPSS = 0.0                                                             172
      J1N = 0                                                                173
      LL = 0                                                                 174
      OUTI = 1.0                                                             175
      N = 0                                                                  176
      TMAX = 0.0                                                             177
      TMIN = 0.0                                                             178
      DO 1110 J = 1,10                                                       179
 1110 J1(J) = 1                                                              180
  110 TNEW = TNINT                                                           181
      OUT = OUTI                                                             182
C                  OUT = 1    MEANS CONVERGENCE.                             183
C                  OUT = 2    MEANS NO CONVERGENCE  PASS ONE                 184
C                  OUT = 3    MEANS NO CONVERGENCE  PASS TWO.                185
  115 RETURN                                                                 186
  500 FORMAT(46H1NO CONVERGENCE IN TNEST, INFORMATION FOLLOWS.  )            187
  501 FORMAT(1H03X,4HN = I3,3X,4HL = I3,3X,8HGUESS = E18.8,3X,12HNEW GUE     188
     1SS = E18.8//,3X,8HT1(N) = E18.8,3X,8HT2(N) = E18.8,3X,8HT3(N) = E1     189
     28.8//,3X,10HTAVG(N) = E18.8,3X,7HTMAX = E18.8,3X,7HTMIN = E18.8//1     190
     3X,7H******* )                                                          191
  505 FORMAT(1H03X,4HN = I3)                                                 192
  506 FORMAT(1H0,14HORIG. GUESS = E20.8,4X,13HORIG. ANS. = E20.8)            193
      END                                                                    194
$IBFTC WDP
      SUBROUTINE WDP(II,L)                                                     1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION ZORE(4)                                                       62
C****         THE EQUATION FOR THE RATE OF CHANGE OF DENSITY WITH             63
C****         RESPECT TO TIME, W-DOT-P, IS DEFINED IN SECTION II.B.2          64
C****       THIS SUBROUTINE COMPUTES THE W-DOT-P FOR EACH POINT.              65
      I = II                                                                  66
      TE = T(I)                                                               67
C****         SECTION FOR SINGLE REACTION.                                    68
      D = DENS(I)                                                             69
      TRM = DENSE(1)*((D-CHART(2))/DENSE(1))**CHART(3)                        70
      IF (GENRL(12)) 9, 1, 9                                                  71
    1 NDENS = INDTL(1)                                                        72
C                              TABLE LOOK-UP FROM Z OR E TABLE.               73
      CALL TABUP(TDENS,ZORET,D,ZORE,NDENS,-4)                                 74
      EX1 = -ZORE(2)/HTCONV(1)/TE                                             75
      WDOTP(L) = -ZORE(1)*EXP(EX1)*TRM                                        76
C                              TABLE LOOK-UP FROM Z OR E TABLE.               77
    5 RETURN                                                                  78
C****         SECTION FOR MULTIPLE REACTION.                                  79
    9 NZ = GENRL(12)                                                          80
      DRDT = 0.0                                                              81
      DO 10 N = 1,NZ                                                          82
      NPNZ = 2 * N                                                            83
      EX1 = -ZORET(NPNZ)/HTCONV(1) / TE                                       84
      N1 = 2 * (N-1) + 1                                                      85
      DRDT = DRDT + ZORET(N1) * EXP(EX1)                                      86
   10 CONTINUE                                                                87
      WDOTP(L) = -DRDT*TRM                                                    88
      GO TO 5                                                                 89
      END                                                                     90
$ORIGIN        ALPHA
$IBFTC CLPOLY
      FUNCTION CLPOLY(ARG,COFARG,NARG)                                         1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C     POLYNOMIAL EVALUATION                                                   62
      DIMENSION COFARG(1)                                                     63
    1 CLPOLY=COFARG(NARG+1)                                                   64
      IF(NARG.EQ.0) GO TO 5001                                                65
      DO 91 J1=1,NARG                                                         66
      N1=NARG-J1+1                                                            67
      CLPOLY=CLPOLY*ARG+COFARG(N1)                                            68
   91 CONTINUE                                                                69
 5001 RETURN                                                                  70
      END                                                                     71
$IBFTC DIFTAB
      SUBROUTINE DIFTAB(Y,X,DYDX,NX,NL)                                        1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
      DIMENSION X(1),Y(1),DYDX(1)                                             62
C     NX = INDEPENDENT TABLE LENGTH,NL = NUMBER OF LAYERS.                    63
C     DETERMINE STARTING POINT OF Y TABLE INTERVAL JK1.                       64
      NX = NX                                                                 65
      NL = NL                                                                 66
      NL1 = NL-1                                                              67
      NX1 = NX+1                                                              68
      NX2 = NX-2                                                              69
      DO 100 JL = 1,NL                                                        70
    2 JK = NX1*JL                                                             71
      JK1 = JK-NX                                                             72
    4 IF (Y(JK)) 5,89,5                                                       73
    5 IF (NX2) 50,50,10                                                       74
C     CALCULATE THE DIFFERENCES FOR THE FIRST POINT.                          75
   10 IF(ABS(Y(JK1+1)-Y(JK1))-ABS(Y(JK1+1)*1.E-7)) 15, 15, 11                 76
   11 D1 = X(2) - X(1)                                                        77
      D2 = X(3)-X(2)                                                          78
      A = -(2.*D1+D2)/D1/(D1+D2)                                              79
      B = (D1+D2)/D1/D2                                                       80
      C = -D1/D2/(D1+D2)                                                      81
C     CALCULATE THE DERIVATIVE OF THE FIRST POINT.                            82
      DYDX(JK1)  = A*Y(JK1)+B*Y(JK1+1)+C*Y(JK1+2)                             83
      GO TO 16                                                                84
   15 DYDX(JK1) = 0.                                                          85
C     CALCULATE THE DIFFERENCES FOR THE MIDDLE POINTS.                        86
   16 DO 20 N = 1,NX2                                                         87
      N1 = N+1                                                                88
      D1 = X(N1)-X(N)                                                         89
      D2 = X(N1+1)-X(N1)                                                      90
      A = -D2/D1/(D1+D2)                                                      91
      B = (D2-D1)/D1/D2                                                       92
      C = D1/D2/(D1+D2)                                                       93
C     CALCULATE THE DERIVATIVES FOR THE MIDDLE POINTS.                        94
      JK2 = JK1+N                                                             95
   19 DYDX(JK2) = A*Y(JK2-1)+B*Y(JK2)+C*Y(JK2+1)                              96
   20 CONTINUE                                                                97
C     CALCULATE THE DIFFERENCES FOR THE END POINT.                            98
      JK3 = JK1+NX-1                                                          99
      IF(ABS(Y(JK3)-Y(JK3-1))-ABS( Y(JK3)*1.E-7)) 29,29,25                   100
   25 D1 = X(NX-1)-X(NX2)                                                    101
      D2 = X(NX)-X(NX-1)                                                     102
      A = D2/D1/(D1+D2)                                                      103
      B = -(D1+D2)/D1/D2                                                     104
      C = (D1+2.*D2)/D2/(D1+D2)                                              105
C     CALCULATE THE DERIVATIVE OF THE LAST POINT.                            106
   30 DYDX(JK3) = A*Y(JK3-2)+B*Y(JK3-1)+C*Y(JK3)                             107
      GO TO 60                                                               108
   29 DYDX(JK3) = 0.                                                         109
      GO TO 60                                                               110
   50 D1 = X(NX)-X(NX-1)                                                     111
      JK3 = JK1+1                                                            112
      DYDX(JK1) = (Y(JK3)-Y(JK1))/D1                                         113
      DYDX(JK3) = DYDX(JK1)                                                  114
   60 NX3 = NX-1                                                             115
      DO 87 J = 1,NX3                                                        116
      JK5 = JK1 +J - 1                                                       117
      IF (ABS(DYDX(JK5+1)-DYDX(JK5))-ABS(DYDX(JK5+1))*1.E-7) 75,80,80        118
   75 DYDX(JK) = 0.                                                          119
      GO TO 87                                                               120
   80 DYDX(JK)  = 1.                                                         121
      GO TO 100                                                              122
   87 CONTINUE                                                               123
      GO TO 100                                                              124
   89 DO 95 K = JK1,JK                                                       125
   95 DYDX(K) = 0.                                                           126
  100 CONTINUE                                                               127
  200 RETURN                                                                 128
      END                                                                    129
$IBFTC ENLARG
      SUBROUTINE ENLARG                                                        1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C************COMMON FOR VARIABLE T-P-D INPUT*******FOR BETA-4 TABLE****       62
      DIMENSION TMDENS(1),TMT(1),TMP(1),XFORT(1),XFORP(1),XFORDN(1)           63
C     ABOVE IS DUMMY DIMENSION -JUST TO ALLOW SUBSCRIBTING                    64
      EQUIVALENCE(TMDENS(1),DENS(301)),(TMT(1),T(301)),(TMP(1),P(301))        65
      EQUIVALENCE(XFORT(1),T(151)),(XFORP(1),P(151)),(XFORDN(1),DENS(151      66
     1))                                                                      67
      EQUIVALENCE(NT,T(449)),(NXT,T(450)),(NP,P(449)),(NXP,P(450))            68
      EQUIVALENCE(ND,DENS(449)),(NXD,DENS(450))                               69
C     THE T-P-AND DENS INPUTS ARE STORED IN THE                               70
C     LAST THIRD OF THEIR RESPECTIVE ARRAYS.                                  71
C     NT-NP-NDENS ETC ARE STORED IN LOC                                       72
C     NOT USED -DUE TO THE IMPOSSIBILITY OF HAVING 150 POINTS                 73
C     THE X TABLE FOR T(XFORT)ETC ARE STORED IN THE                           74
C     MIDDLE THIRD OF THEIR RESPECTIVE ARRAYS                                 75
C     FOR THE BETA 4 TABLE HAVING PSEUDO - VARIABLE DIMENSION                 76
      COMMON TXQTAB(200),NOFTS,NOFXS,NTXQ(50),ICON,JCON,END                   77
      CALL EXPAND(NWARM,PROPT,630,WARM,NPROPT,30)                             78
      CALL EXPAND(NWARM,GASPR,105,WARM,NGASPR,5)                              79
      CALL EXPAND(NWARM,HTABL,42,WARM,NHTABL,2)                               80
      CALL EXPAND(NWARM,CTABL,210,WARM,NCTABL,5)                              81
      CALL EXPAND(NHORA,TTABL,510,HORA,NTTABL,10)                             82
      CALL EXPAND( NTDENS,ZORET,84,TDENS,NZORET,2)                            83
      CALL EXPAND( NDGREE,ATETB,420,DGREE,NATETB,20)                          84
      INDTL(1) = NTDENS                                                       85
      INDTL(2) = NDGREE                                                       86
      INDTL(4) = NWARM                                                        87
      INDTL(5) = NHORA                                                        88
C     TEST DATA FOR VARIABLE T-P-DENS DISTRIBUTIONS.                          89
C     NO. OF ENTRIES FOR ASSOCIATED TABLES MUST BE EQUAL.                     90
C     CHECK DENSITY INPUT                                                     91
      IF (GENRL(4)) 275,200,275                                               92
  200 IF (ND.EQ.NXD) GO TO 215                                                93
      WRITE (6,205)ND,NXD                                                     94
  205 FORMAT (1HO,43HBAD COUNT ON VARIABLE DENSITY TABLE   ND = I4,5X,5H      95
     1ND = I4)                                                                96
      CALL ERROR                                                              97
C     CHECK PRESSURE INPUT                                                    98
  215 IF (NP.EQ.NXP) GO TO 230                                                99
      WRITE (6,220) NP,NXP                                                   100
  220 FORMAT (1HO,44HBAD COUNT ON VARIABLE PRESSURE TABLE   NP = I4,5X,6     101
     1HNXP = I4)                                                             102
      CALL ERROR                                                             103
  230 IF (NT.EQ.NXT) GO TO 275                                               104
C     CHECK TEMP INPUT                                                       105
      WRITE (6,240)NT,NXT                                                    106
  240 FORMAT (1HO,41HBAD COUNT ON VARIABLE TEMP. TABLE   NT = I4,5X,6HNX     107
     1T = I4)                                                                108
      CALL ERROR                                                             109
C     THIS ENDS THE TESTING FOR VARIABLE DISTRIBUTION INPUT.                 110
C     BEGIN HERE TO TEST INPUT FOR INTERNAL HEAT GENERATION                  111
C     BETA-4CORRECTION.-IF NEEDED                                            112
  275 IF (NOFTS) 300,350,300                                                 113
C     CHECK NUMBER OF TEMP TABLES.                                           114
  300 IF (NOFTS.LT.148) GO TO 315                                            115
      WRITE (6,305)NOFTS                                                     116
  305 FORMAT (1HO,42HMAXIMUM NO OF TEMP TABLES = 148 YOU HAVE  I4)           117
      CALL ERROR                                                             118
C     CHECK NUMBER OF ENTRIES PER TABLE.                                     119
  315 DO 310 JD = 3,NOFTS                                                    120
      IF (NOFXS.EQ.NTXQ(JD)) GO TO 310                                       121
      WRITE (6,307)JD,NOFXS,NTXQ(JD)                                         122
                                                                             123
  307 FORMAT (1HO,26HBAD COUNT ON B4 TEMP TABLEI4,3X,9HSHOULD = I4,4X,10     124
     1HYOU HAVE  I4)                                                         125
      CALL ERROR                                                             126
  310 CONTINUE                                                               127
C     THIS FINISHES CHECKING THE B4 INPUT. PROCEED WITH THE PROGRAM.         128
  350 RETURN                                                                 129
      END                                                                    130
$IBFTC EXEC1
      SUBROUTINE EXEC1                                                         1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C************COMMON FOR VARIABLE T-P-D INPUT*******FOR BETA-4 TABLE****       62
      DIMENSION TMDENS(1),TMT(1),TMP(1),XFORT(1),XFORP(1),XFORDN(1)           63
C     ABOVE IS DUMMY DIMENSION -JUST TO ALLOW SUBSCRIBTING                    64
      EQUIVALENCE(TMDENS(1),DENS(301)),(TMT(1),T(301)),(TMP(1),P(301))        65
      EQUIVALENCE(XFORT(1),T(151)),(XFORP(1),P(151)),(XFORDN(1),DENS(151      66
     1))                                                                      67
      EQUIVALENCE(NT,T(449)),(NXT,T(450)),(NP,P(449)),(NXP,P(450))            68
      EQUIVALENCE(ND,DENS(449)),(NXD,DENS(450))                               69
C     THE T-P-AND DENS INPUTS ARE STORED IN THE                               70
C     LAST THIRD OF THEIR RESPECTIVE ARRAYS.                                  71
                                                                              72
C     NT-NP-NDENS ETC ARE STORED IN LOC                                       73
C     NOT USED -DUE TO THE IMPOSSIBILITY OF HAVING 150 POINTS                 74
C     THE X TABLE FOR T(XFORT)ETC ARE STORED IN THE                           75
C     MIDDLE THIRD OF THEIR RESPECTIVE ARRAYS                                 76
C     FOR THE BETA 4 TABLE HAVING PSEUDO - VARIABLE DIMENSION                 77
      COMMON TXQTAB(200),NOFTS,NOFXS,NTXQ(50),ICON,JCON,END                   78
      COMMON MK                                                               79
      DIMENSION TABLN(120)                                                    80
C                       SET UP THE SPACING IN THE FIRST LAYER.                81
C****              COMPUTE R VALUES,ETA DERIVATIVES AND X LOCATIONS.          82
C                       THIS SUBROUTINE CONTROLS                              83
C                       THE MAIN FLOW OF THE                                  84
C                       PROGRAM. IT CALLS THE                                 85
C                       SUBROUTINES IN THEIR CORRECT                          86
C                       AND LOGICAL ORDER, AND CAN                            87
C                       BE CONSIDERED AS A GENERAL                            88
C                       TYPE OF FLOW CHART.                                   89
    2 GO TO (3,4),ICON                                                        90
    3 CALL INIT(4)                                                            91
       MK = 0                                                                 92
C                       READ IN HEADING                                       93
    4 READ(5,5) (HEAD(I), I = 2,13)                                           94
    5 FORMAT(12A6)                                                            95
C                       READ IN INPUT VALUES BY CALLING INPUT                 96
      CALL INPUT(1,END,ALLNEW)                                                97
C                  INITIALIZE TABLES, ETC.                                    98
C****         CHECK MK TO SEE IF A RESTART TAPE WAS USED.                     99
      IF (MK) 8, 10, 8                                                       100
    8 CALL INIT (5)                                                          101
      CALL TABOUT                                                            102
      JCON = 2                                                               103
      GO TO 25                                                               104
   10 CALL INIT(1)                                                           105
C                       PRINT OUT THE INPUT TABLES.                          106
   11 CALL TABOUT                                                            107
   12 CALL RITER(1)                                                          108
C****                   COMPUTE THE ETA(T)-S INITIALLY.                      109
   13 CALL NSUBT                                                             110
C                       COMPUTE THE STARTING TEMPERATURES,                   111
C                       DENSITIES, AND PRESSURES.                            112
   14 CALL STARTT                                                            113
C                       COMPUTE THE DELTA T.                                 114
      JCON = 1                                                               115
   25 RETURN                                                                 116
   97 IF(END)3,98,3                                                          117
   98 CALL INIT(3)                                                           118
      GO TO 4                                                                119
      END                                                                    120
$IBFTC EXPAND
      SUBROUTINE EXPAND(MIND,XTABL,MARAY,ENDTBL,NVLUS,NMTB)                    1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C                    THIS SUBROUTINE IS USED TO EXPAND A                      62
C                    DEPENDENT TABLE ACCORDING TO THE NUMBER OF VALUES        63
C                    IN THE CORRESPONDING INDEPENDENT TABLE                   64
C                    THE SUBROUTINE FOLLOWS THE PROCEDURE OF PLACING          65
C                    THE TABLES  (GOING FROM THE LAST TO THE FIRST)           66
C                    AT THE END OF THE ARRAY READING FROM THE LAST            67
C                    ENTRY TO THE FIRST IN THE TABLE.                         68
C                    ONCE ALL THE TABLES HAVE BEEN EXPANDED                   69
C                    AND MOVED TO THE BACK OF THE ARRAY,THE BLOCK             70
C                    IS SHIFTED FORWARD SO THAT THE TABLES ARE                71
C                    IN THEIR PROPER LOCATIONS                                72
C                    THE NPLCE ARRAY STORES THE LOCATION                      73
C                    FROM THE START OF THE DEPENDENT TABLE ARRAY              74
C                    TO THE LAST ENTRY OF A PARTICULAR TABLE                  75
C                    IN THE ARRAY                                             76
C                    NSLSH IS THE LOCATION WHICH STORES                       77
C                    THE NUMBER OF TABLES READ INTO THE ARRAY                 78
      DIMENSION XTABL(1),NVLUS(1),NPLCE(31),ENDTBL(1)                         79
      IF(NVLUS(1).EQ.0) GO TO 60                                              80
      NIND=MIND                                                               81
      IF(NIND .EQ. 0 ) GO TO 60                                               82
      NARAY=MARAY                                                             83
      MXTB=NMTB                                                               84
      NSLSH=0                                                                 85
      NPLCE(1)=0                                                              86
      NADD=0                                                                  87
      DO 7 I=1,MXTB                                                           88
      NADD=NADD+NVLUS(I)                                                      89
      IF(NVLUS(I)) 8,9,1                                                      90
    1 NSLSH=NSLSH +1                                                          91
      NPLCE(NSLSH+1)=NADD                                                     92
    7 CONTINUE                                                                93
      GO TO 9                                                                 94
    8 CALL ERROR(5,30H  THERE IS A TABLE INPUT ERROR)                         95
C                            TEST IF A TABLE WAS READ IN                      96
    9 IF(NSLSH) 8,60,10                                                       97
   10 DO 49 I = 1,NSLSH                                                       98
      KSLSH=NSLSH-I+1                                                         99
      NUMB=NVLUS(KSLSH)                                                      100
C                            TEST TO FIND THE NUMBER OF                      101
C                            VALUES IN EACH TABLE                            102
      IF(NUMB-2) 20,30,18                                                    103
C                    TEST IF ALL VALUES ARE IN THE TABLE                     104
   18 IF(NUMB-NIND) 8,40,8                                                   105
C                            THERE IS ONE VALUE SO THE                       106
C                            TABLE IS CONSTANT                               107
   20 JK=NARAY-(I-1)*(NIND+1)                                                108
      JK1=NPLCE(KSLSH)                                                       109
      TEMVL=XTABL(JK1+1)                                                     110
      XTABL(JK)=0.                                                           111
      DO 25 J=1,NIND                                                         112
      KJ = JK-J                                                              113
   25 XTABL(KJ) = TEMVL                                                      114
      GO TO 49                                                               115
C                            THERE ARE TWO VALUES SO THE                     116
C                            TABLE MUST BE EXPANDED BY                       117
C                            INTERPOLATION                                   118
   30 KK = NPLCE(KSLSH)                                                      119
      DEP1 = XTABL(KK+1)                                                     120
      DEP2 = XTABL(KK+2)                                                     121
      JK = NARAY-(I-1)*(NIND+1)                                              122
      XTABL(JK) = 1.                                                         123
      DO 35 J = 1,NIND                                                       124
      KJ = JK+J-NIND-1                                                       125
   35 XTABL(KJ) = (ENDTBL(J)*(DEP2-DEP1)/(ENDTBL(NIND)-ENDTBL(1)))+((        126
     1ENDTBL(NIND)*DEP1)-(ENDTBL(1)*DEP2))/(ENDTBL(NIND)-ENDTBL(1))          127
      GO TO 49                                                               128
C                            THE WHOLE TABLE IS IN AND                       129
C                            MUST BE TRANSFERRED AND                         130
C                            EXPANDED                                        131
   40 LL = NPLCE(KSLSH+1)+1                                                  132
      JK = NARAY-(I-1)*(NIND+1)                                              133
      XTABL(JK) = 1.                                                         134
      DO 45 J = 1,NIND                                                       135
      KJ = JK-J                                                              136
      LL1=LL-J                                                               137
   45 XTABL(KJ) = XTABL(LL1)                                                 138
   49 CONTINUE                                                               139
C                            NOW THE TABLES MUST BE                          140
C                            MOVED TO THEIR PROPER LOCATIONS                 141
C                            IN THE ARRAY                                    142
   50 KSTART = NSLSH*(NIND+1)                                                143
      JSTART = NARAY-KSTART+1                                                144
      KCONT = 0                                                              145
      DO 55 J = JSTART,NARAY                                                 146
      KCONT = KCONT+1                                                        147
   55 XTABL(KCONT) = XTABL(J)                                                148
      KCONT = KCONT+1                                                        149
      IF(KCONT.GT.NARAY) GO TO 57                                            150
      DO 56 L = KCONT,NARAY                                                  151
   56 XTABL(L) = 0.                                                          152
   57 DO 58 IK=1,NSLSH                                                       153
   58 NVLUS(IK)=0                                                            154
   60 RETURN                                                                 155
      END                                                                    156
$IBFTC INPUT
      SUBROUTINE INPUT(K,X,Y)                                                  1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C************COMMON FOR VARIABLE T-P-D INPUT*******FOR BETA-4 TABLE****       62
      DIMENSION TMDENS(150),TMT(150),TMP(150),XFORT(300),XFORP(300),          63
     1XFORDN(300)                                                             64
      EQUIVALENCE(TMDENS(1),DENS(301)),(TMT(1),T(301)),(TMP(1),P(301))        65
      EQUIVALENCE(XFORT(1),T(151)),(XFORP(1),P(151)),(XFORDN(1),DENS(151      66
     1))                                                                      67
      EQUIVALENCE(NT,T(449)),(NXT,T(450)),(NP,P(449)),(NXP,P(450))            68
      EQUIVALENCE(ND,DENS(449)),(NXD,DENS(450))                               69
C     THE T-P-AND DENS INPUTS ARE STORED IN THE                               70
C     LAST THIRD OF THEIR RESPECTIVE ARRAYS.                                  71
C     NT-NP-NDENS ETC ARE STORED IN LOC                                       72
C     NOT USED -DUE TO THE IMPOSSIBILITY OF HAVING 150 POINTS                 73
C     THE X TABLE FOR T(XFORT)ETC ARE STORED IN THE                           74
C     MIDDLE THIRD OF THEIR RESPECTIVE ARRAYS                                 75
C     FOR THE BETA 4 TABLE HAVING PSEUDO - VARIABLE DIMENSION                 76
      COMMON TXQTAB(200),NOFTS,NOFXS,NTXQ(50),ICON,JCON,END                   77
      DIMENSION X(1),Y(1)                                                     78
      DIMENSION TABLD(20),SCDTB(20),SCITB(20),GRAPH(20)                       79
      EQUIVALENCE (PVAR,GRAPH) , (PVAR(21),SCITB) , (TRAJV,SCDTB) ,           80
     1             (TRAJV(21),TABLD)                                          81
C****         NAMELIST STATEMENTS FOR GE-STC.                                 82
      NAMELIST /REKAP /  AGPTB,    DENSE,    DTIME,    EPTAB,    GENRL,       83
     1                   OUTTB,    PTSIN,    SPACE,    THIKN,                 84
     2                   CTABL,    HTABL,    NCTABL,   NHTABL,   NPROPT,      85
     3                   NWARM,    PROPT,    WARM,                            86
     5                   CHART,    GASPR,    NGASPR,   NTDENS,   NZORET,      87
     4                   HORA ,    NHORA,    NTTABL,   TTABL,                 88
     6                   TDENS,    ZORET,    TMELT ,   TRAJT ,                89
     7                   ATETB,    DGREE ,   NDGREE,   NATETB,  NPHI   ,      90
     8                   NU   ,    PHII  ,   STVAR ,   PVAR,                  91
C****         ADD TO NAMELIST.                                                92
C                                                                             93
     9                   TXQTAB,  NTXQ,  TMT,  NT,  XFORT,  NXT,              94
     1                   TMP,  NP,  XFORP,  NXP,  TMDENS,  XFORDN,  NXD,      95
     2                   ALLNEW,  END,  AMPLCT,  BACKFC,  ND                  96
      READ (5,REKAP)                                                          97
      INDTL(1) = NTDENS                                                       98
      INDTL(2) = NDGREE                                                       99
      INDTL(4) = NHORA                                                       100
      INDTL(5) = NWARM                                                       101
      X = END                                                                102
      Y = ALLNEW                                                             103
      RETURN                                                                 104
      END                                                                    105
$IBFTC STARTT
      SUBROUTINE STARTT                                                        1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C************COMMON FOR VARIABLE T-P-D INPUT*******FOR BETA-4 TABLE****       62
      DIMENSION TMDENS(1),TMT(1),TMP(1),XFORT(1),XFORP(1),XFORDN(1)           63
C     ABOVE IS DUMMY DIMENSION -JUST TO ALLOW SUBSCRIBTING                    64
      EQUIVALENCE(TMDENS(1),DENS(301)),(TMT(1),T(301)),(TMP(1),P(301))        65
      EQUIVALENCE(XFORT(1),T(151)),(XFORP(1),P(151)),(XFORDN(1),DENS(151      66
     1))                                                                      67
      EQUIVALENCE(NT,T(449)),(NXT,T(450)),(NP,P(449)),(NXP,P(450))            68
      EQUIVALENCE(ND,DENS(449)),(NXD,DENS(450))                               69
C     THE T-P-AND DENS INPUTS ARE STORED IN THE                               70
C     LAST THIRD OF THEIR RESPECTIVE ARRAYS.                                  71
C     NT-NP-NDENS ETC ARE STORED IN LOC                                       72
C     NOT USED -DUE TO THE IMPOSSIBILITY OF HAVING 150 POINTS                 73
C     THE X TABLE FOR T(XFORT)ETC ARE STORED IN THE                           74
C     MIDDLE THIRD OF THEIR RESPECTIVE ARRAYS                                 75
C     FOR THE BETA 4 TABLE HAVING PSEUDO - VARIABLE DIMENSION                 76
      COMMON TXQTAB(200),NOFTS,NOFXS,NTXQ(50),ICON,JCON,END                   77
C****         THIS ROUTINE IS A CONDUCTION SOLUTION DISCUSSED IN              78
C****         SECTION VI OF THE ANALYSIS.                                     79
C****         IT DETERMINES THE STARTING TEMPERATURES FOR THE RUN.            80
      DIMENSION COF(7)                                                        81
C****         COF IS USED IN THE ERROR FUNCTION COMPUTATION.                  82
      DATA COF/1.0,7.05230784E-2,4.22820123E-2,9.2705272E-3,1.520143E-4,      83
     12.765672E-4,4.30638E-5/                                                 84
      IF (GENRL(4))  1,80,1                                                   85
    1 LAYER = KONVAR(4)                                                       86
      KTIME = KONVAR(2)                                                       87
      NTEMP = INDTL(4)                                                        88
      NTIME = INDTL(5)                                                        89
      ITIME = KONVAR(1)                                                       90
      KT1 = KONVAR(2)+1                                                       91
      IT1 = KONVAR(1)+1                                                       92
      T(1) = GENRL(4)                                                         93
      T1 = T(1)                                                               94
      TIMEO = ABS(GENRL(3)) + GENRL(1)                                        95
      DENS(1) = DENSE(1)                                                      96
      DO 9 J = 1,LAYER                                                        97
      NPTS = PTSIN(J) + 1.                                                    98
C****         STORE INITIAL T-S, AND DENSITIES IN THEIR PROPER ARRAYS         99
      DO 8 I = 1,NPTS                                                        100
      MN = JLAYER(J) + I + 1                                                 101
    5 T(MN) = GENRL(4)                                                       102
    7 DENS(MN)=DENSE(J)                                                      103
    8 CONTINUE                                                               104
    9 CONTINUE                                                               105
C****              CLEAR Q-S FOR HTBLNS ROUTINE.                             106
      DO 11 N = 1,12                                                         107
      Q(1,N) = 0.0                                                           108
   11 CONTINUE                                                               109
   15 IF (GENRL(3)) 17,64,16                                                 110
C****         COMPUTE R1 FOR LINEAR HEAT FLUX                                111
   16 R1 = 1.                                                                112
      GO TO 18                                                               113
C****         COMPUTE R1 FOR JUMP HEAT FLUX                                  114
   17 R1 = 1.5                                                               115
   18 CALL CHARP(1,1)                                                        116
      CALL TABUP(WARM,PROPT,T(1),PROP,NTEMP,-2)                              117
      CCPP = PROP(1)                                                         118
      CKAY = PROP(2)                                                         119
      CPA = CHARV(3)                                                         120
      AK = CHARV(1)                                                          121
      BARC1 = 4./3.*SQRT(TIMEO/3.1415927)*(1./SQRT(DENSE(1)*CCPP*CPA*AK*     122
     1CKAY))*R1                                                              123
      BARC2 = GENRL(4)                                                       124
C                       Q ITERATION BLOCK.                                   125
C                       IF GENRL(5) = -  LOOK UP FRONT FACE TEMP.            126
      IF(GENRL(5)) 20,30,30                                                  127
   20 CALL TABUP (HORA,TTABL,CTIME,TIVAR(1),NTIME,1)                         128
      T(1) = TIVAR(1)                                                        129
      Q(KT1,1) = (T(1)-GENRL(4))/BARC1                                       130
      GO TO 45                                                               131
C                       IF GENRL(5) = +  CALCULATE THE FRONT FACE TEMP.      132
   30 TOH = T(1)                                                             133
      T(IT1) = T(1)                                                          134
      EP = -EPTAB(3)                                                         135
C****         COMPUTE THE Q OF THE FRONT FACE                                136
   31 CALL QNET                                                              137
C****         T(II) IS DEFINED IN EQUATION VI.6                              138
      T(IT1) = GENRL(4)+BARC1*Q(KT1,1)                                       139
      T2 = T(IT1)                                                            140
      IF(T2-WARM(NTEMP)) 32,32,33                                            141
   32 IF(T2-WARM(1)) 34,38,38                                                142
   33 T2 = WARM(NTEMP)                                                       143
      GO TO 38                                                               144
   34 T2 = WARM(1)                                                           145
   38 CALL TNEST(T(ITIME+1),T1,EP)                                           146
      EP = ABS(EP)                                                           147
      NT1 = T1                                                               148
      GO TO (40,31,39),NT1                                                   149
   39 WRITE(6,500)  T(IT1),Q(KT1,1)                                          150
      GO TO 31                                                               151
   40 T(1) = T(IT1)                                                          152
C                       END OF Q ITERATION BLOCK.                            153
   45 DO 47 N = 1,6                                                          154
   47 Q(1,N)=Q(2,N)                                                          155
      NPTS = PTSIN(1)+2.                                                     156
      QPDNET = Q(KT1,1)/TIMEO                                                157
C                       SET UP LOOP TO ACTUALLY CALCULATE                    158
C                       THE STARTING TEMPERATURES.                           159
      DO 63 I = 1,NPTS                                                       160
      XLOCI = ABS(XLOC(1) - XLOC(I))                                         161
      ZEE = XLOCI/(2.*SQRT((CKAY*AK)/(DENSE(1)*CCPP*CPA)*TIMEO))             162
C****         ERFCZ IS DEFINED IN EQUATION VI.1                              163
      IF(ZEE .EQ. 0.0) GO TO 147                                             164
      CLCLCL=CLPOLY(ABS(ZEE),COF,6)                                          165
C****         CHECK IF CLCLCL WILL OVERFLOW WHEN                             166
C****         RAISED TO THE SIXTEENTH POWER                                  167
      IF(CLCLCL.GE.128.) GO TO 146                                           168
      ERFCZ=SIGN(1.0,ZEE)*(1.0-(CLCLCL)**(-16))                              169
      GO TO 160                                                              170
  146 ERFCZ=1.0                                                              171
      GO TO 160                                                              172
  147 ERFCZ = 0.0                                                            173
  160 PRT1 = (4./3.*R1*QPDNET*TIMEO**1.5)/SQRT(CKAY*AK*DENSE(1)*CCPP*CPA     174
     1)                                                                      175
      IF((ZEE**2)-80.) 60,60,59                                              176
   59 PRT2=0.                                                                177
      PRT3=0.                                                                178
      GO TO 63                                                               179
   60 PRT2=(1.+ZEE**2)**(3.-2.*R1)/(SQRT(3.1415927))*EXP(-(ZEE**2))          180
      PRT3=(ZEE*((3.+2.*ZEE**2)/2.)**(3.-2.*R1))*(1.-ERFCZ)                  181
C****         T(I) IS DEFINED IN EQUATION VI.7                               182
   63 T(I) = PRT1*(PRT2-PRT3)+GENRL(4)                                       183
   64 CALL HTBLNS(0)                                                         184
      IF(KONVAR(7) - 2) 70, 65, 70                                           185
C                       COMPUTE INTIAL PRESSURE                              186
C                       DISTRIBUTION.                                        187
C****              INITIAL TEMPERATURE AND RHO(G) MUST BE IN FIRST.          188
   65 CALL DPRESS(1,1,-1)                                                    189
   70 RETURN                                                                 190
C     AT 80 A VARIABLE TEMP-PRESS-DENS DISTRIBUTION IS                       191
C     BEING READ IN- SO PUT VALUES IN                                        192
C     CORRECT LOCATIONS                                                      193
C     PLACE A 1 IN LAST ELEMENT OF EACH DEP TABLE                            194
   80 TMT(NT+1) = 1.                                                         195
      TMP(NP+1) = 1.                                                         196
      TMDENS(ND+1) = 1.                                                      197
      KON2L = KONVAR(1)                                                      198
      DO 100 JD = 1,KON2L                                                    199
      CALL TABUP(XFORT,TMT,XLOC(JD),T(JD),NT,1)                              200
      CALL TABUP(XFORP,TMP,XLOC(JD),P(JD),NP,1)                              201
      CALL TABUP(XFORDN,TMDENS,XLOC(JD),DENS(JD),ND,1)                       202
  100 CONTINUE                                                               203
C     ERASE LAST TWO THIRDS OF T-P AND DENS ARRAYS                           204
      DO 110 JD = 1,150                                                      205
      TMDENS(JD) = 0.                                                        206
      XFORDN(JD) = 0.                                                        207
      TMP(JD) = 0.                                                           208
      XFORP(JD) = 0.                                                         209
      TMT(JD) = 0.                                                           210
      XFORT(JD) = 0.                                                         211
  110 CONTINUE                                                               212
      GO TO 70                                                               213
  500 FORMAT (1H0,3X,15HTNEST IN STARTT,4X,10HT(F.F.) = E20.8,4X,7HQNET      214
     1= E20.8)                                                               215
      STOP                                                                   216
      END                                                                    217
$IBFTC TABOUT
      SUBROUTINE TABOUT                                                        1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C************COMMON FOR VARIABLE T-P-D INPUT*******FOR BETA-4 TABLE****       62
      DIMENSION TMDENS(1),TMT(1),TMP(1),XFORT(1),XFORP(1),XFORDN(1)           63
C     ABOVE IS DUMMY DIMENSION -JUST TO ALLOW SUBSCRIBTING                    64
      EQUIVALENCE(TMDENS(1),DENS(301)),(TMT(1),T(301)),(TMP(1),P(301))        65
      EQUIVALENCE(XFORT(1),T(151)),(XFORP(1),P(151)),(XFORDN(1),DENS(151      66
     1))                                                                      67
      EQUIVALENCE(NT,T(449)),(NXT,T(450)),(NP,P(449)),(NXP,P(450))            68
      EQUIVALENCE(ND,DENS(449)),(NXD,DENS(450))                               69
C     THE T-P-AND DENS INPUTS ARE STORED IN THE                               70
C     LAST THIRD OF THEIR RESPECTIVE ARRAYS.                                  71
C     NT-NP-NDENS ETC ARE STORED IN LOC                                       72
C     NOT USED -DUE TO THE IMPOSSIBILITY OF HAVING 150 POINTS                 73
C     THE X TABLE FOR T(XFORT)ETC ARE STORED IN THE                           74
C     MIDDLE THIRD OF THEIR RESPECTIVE ARRAYS                                 75
C     FOR THE BETA 4 TABLE HAVING PSEUDO - VARIABLE DIMENSION                 76
      COMMON TXQTAB(200),NOFTS,NOFXS,NTXQ(50),ICON,JCON,END                   77
      DIMENSION FMT(13)                                                       78
C     THIS IS THE HEADING SECTION                                             79
      DATA ANCT/6HCONST./                                                     80
      DATA ANVAR/6HVARIB./                                                    81
C****              CONST. IS STORED IN ANCT                                   82
C****              VARIB. IS STORED IN ANVAR                                  83
      WRITE (6,1500) (HEAD(I), I = 2,13)                                      84
      LAYER = KONVAR(4)                                                       85
      JGAP = KONVAR(5)                                                        86
      NTIME = INDTL(5)                                                        87
      NTEMP = INDTL(4)                                                        88
      NDENS = INDTL(1)                                                        89
    1 WRITE (6,1501)                                                          90
C****         SECTION FOR THE PTSIN, DENSE, AND THIKN TABLES.                 91
      WRITE (6,1542)                                                          92
      DO 10 K = 1,LAYER                                                       93
   10 WRITE(6,1543)  K,PTSIN(K),THIKN(K),DENSE(K)                             94
      WRITE (6,1611)                                                          95
C****         SECTION FOR TEMPERATURE DEPENDENT TABLES.                       96
C****         WRITE OUT THE APPROPRIATE HEADINGS.                             97
      WRITE (6,1608)                                                          98
      IF(STVAR(1)) 12, 12, 15                                                 99
   12 DO 14 J = 1,LAYER                                                      100
      WRITE (6,1502) J                                                       101
      WRITE (6,1505)                                                         102
      DO 14 I = 1,NTEMP                                                      103
      MN = (NTEMP+1)*(J-1)+I                                                 104
      MN1 = (NTEMP+1)*(3*(J-1))+I                                            105
      MN2 = (NTEMP+1)*(3*(J-1)+1)+I                                          106
      MN3 = (NTEMP+1)*(3*(J-1)+2)+I                                          107
   14 WRITE(6,1506)WARM(I),PROPT(MN1),PROPT(MN2),PROPT(MN3),CTABL(MN)        108
      GO TO 28                                                               109
C****         TEMP. DEPENDENT MATERIAL AND STRESS PROPERTY TABLES.           110
   15 DO26 J = 1,LAYER                                                       111
      WRITE (6,1502) J                                                       112
      WRITE(6,1563)                                                          113
      NDGR1 = NDGREE + 1                                                     114
      DO26 I = 1,NTEMP                                                       115
      MN = (NTEMP+1)*(J-1)+I                                                 116
      MN1 = (NTEMP+1)*(3*(J-1))+I                                            117
      MN2 = (NTEMP+1)*(3*(J-1)+1)+I                                          118
      MN3 = (NTEMP+1)*(3*(J-1)+2)+I                                          119
      MD = NDGR1 * (4*(J-1)) + I                                             120
      MD3 = NDGR1 * (4*(J-1)+2) + I                                          121
   26 WRITE(6,1564)WARM(I),PROPT(MN1),PROPT(MN2),PROPT(MN3),CTABL(MN),       122
     1ATETB(MD),ATETB(MD3)                                                   123
      WRITE(6,1567)STVAR(1),STVAR(2),STVAR(3)                                124
C****         TEMP. DEPENDENT GAS PROPERTY TABLES.                           125
   28 WRITE(6,1508)                                                          126
      DO 39 I = 1,NTEMP                                                      127
      MN1 = I                                                                128
      MN2 = NTEMP+1+I                                                        129
      MN3 = MN2+NTEMP+1                                                      130
      MN4 = MN3+NTEMP+1                                                      131
      MN5=MN4+NTEMP+1                                                        132
   39 WRITE(6,1509)WARM(I),GASPR(MN1),GASPR(MN2),GASPR(MN3),GASPR(MN4),G     133
     1ASPR(MN5),HTABL(MN1),HTABL(MN2)                                        134
C****         SECTION TO TEST AND WRITE OUT IF TABLES ARE                    135
C****              CONSTANT OR VARIABLE.                                     136
      N = NTEMP+1                                                            137
      DO 360 J = 1,LAYER                                                     138
      J = J                                                                  139
      MN = J*N                                                               140
      MD = J * NDGR1                                                         141
      NDG3 = 3 * MD                                                          142
      DO 310 I = 1,3                                                         143
      MN1 = I*J*N                                                            144
      IF (PROPT(MN1)) 308,304,308                                            145
  304 FMT(I) = ANCT                                                          146
      GO TO 310                                                              147
  308 FMT(I) = ANVAR                                                         148
  310 CONTINUE                                                               149
      DO 320 I = 1,5                                                         150
      MN1 = I*J*N                                                            151
      IF (GASPR(MN1)) 318,314,318                                            152
  314 FMT(I+3) = ANCT                                                        153
      GO TO 320                                                              154
  318 FMT(I+3) = ANVAR                                                       155
  320 CONTINUE                                                               156
      DO 330 I = 1,2                                                         157
      MN1 = I*J*N                                                            158
      IF (HTABL(MN1)) 326,322,326                                            159
  322 FMT(I+8) = ANCT                                                        160
      JK2 = JK1+N                                                            161
      JK3 = JK2+N                                                            162
      GO TO 330                                                              163
  326 FMT(I+8) = ANVAR                                                       164
  330 CONTINUE                                                               165
      IF (CTABL(MN)) 336,332,336                                             166
  332 FMT(11) = ANCT                                                         167
      GO TO 340                                                              168
  336 FMT(11) = ANVAR                                                        169
  340 IF (STVAR(1)) 341,358,341                                              170
  341 IF(ATETB(MD)) 346, 342, 346                                            171
  342 FMT(12) = ANCT                                                         172
      GO TO 350                                                              173
  346 FMT(12) = ANVAR                                                        174
  350 IF(ATETB(NDG3)) 356, 352, 356                                          175
  352 FMT(13) = ANCT                                                         176
      GO TO 358                                                              177
  356 FMT(13) = ANVAR                                                        178
  358 WRITE(6,1600)FMT(1),FMT(2),FMT(3),FMT(11)                              179
      WRITE(6,1601)FMT(4),FMT(5),FMT(6),FMT(7)                               180
      WRITE(6,1602)FMT(8),FMT(9),FMT(10)                                     181
      IF (STVAR(1)) 359,360,359                                              182
  359 WRITE(6,1603)FMT(12),FMT(13)                                           183
  360 CONTINUE                                                               184
      WRITE(6,1611)                                                          185
      WRITE(6,1609)                                                          186
C****         SECTION FOR TIME DEPENDENT TABLES.                             187
C****         WRITE OUT THE APPROPRIATE HEADINGS.                            188
      N = NTIME+1                                                            189
      DO 436 K = 1,5,4                                                       190
      K = K                                                                  191
      IF( K-5) 430, 431, 431                                                 192
  430 WRITE(6,1531)                                                          193
      KZ = 0                                                                 194
      GO TO 432                                                              195
  431 WRITE(6,1532)                                                          196
      KZ = 5*N                                                               197
  432 DO 435 KL = 1,NTIME                                                    198
      JK1 = KZ + KL                                                          199
      JK2 = JK1 + N                                                          200
      JK3 = JK2 + N                                                          201
      JK4 = JK3+N                                                            202
      JK5 = JK4+N                                                            203
  433 WRITE(6,1533)HORA(KL),TTABL(JK1),TTABL(JK2),TTABL(JK3),TTABL(JK4),     204
     1TTABL(JK5)                                                             205
  435 CONTINUE                                                               206
  436 CONTINUE                                                               207
C*****        SECTION TO TEST AND WRITE OUT IF THE TABLES ARE                208
C****              CONSTANT OR VARIABLE.                                     209
      N = NTIME+1                                                            210
      DO 470 I = 1,10                                                        211
      MN1 = I*N                                                              212
      IF (TTABL(MN1)) 466,462,466                                            213
  462 FMT(I) = ANCT                                                          214
      GO TO 470                                                              215
  466 FMT(I) = ANVAR                                                         216
  470 CONTINUE                                                               217
      WRITE(6,1604)FMT(1),FMT(2),FMT(3),FMT(4)                               218
      WRITE(6,1605)FMT(5),FMT(6),FMT(7),FMT(8)                               219
      WRITE(6,1606)FMT(9),FMT(10)                                            220
      WRITE(6,1611)                                                          221
C****         SECTION FOR THE DENSITY DEPENDENT TABLES.                      222
C****         WRITE OUT THE APPROPRIATE HEADINGS.                            223
      IF (CHART(1)) 512, 616, 512                                            224
  512 WRITE(6,1610)                                                          225
      WRITE(6,1512)                                                          226
      DO 513 L = 1,NDENS                                                     227
      IZE2 = (NDENS+1)+L                                                     228
      IZE3 = IZE2+NDENS+1                                                    229
      IZE4 = IZE3+NDENS+1                                                    230
  513 WRITE(6,1513)TDENS(L),ZORET(L),ZORET(IZE2),ZORET(IZE3),ZORET(IZE4)     231
C*****        SECTION TO TEST AND WRITE OUT IF THE TABLES ARE                232
C****              CONSTANT OR VARIABLE.                                     233
      N = NDENS+1                                                            234
      DO 580 I = 1,2                                                         235
      MN1 = I*N                                                              236
      IF (ZORET(MN1)) 576,572,576                                            237
  572 FMT(I) = ANCT                                                          238
      GO TO 580                                                              239
  576 FMT(I) = ANVAR                                                         240
  580 CONTINUE                                                               241
      WRITE(6,1607)FMT(1),FMT(2)                                             242
      WRITE(6,1611)                                                          243
C****         SECTION TO WRITE OUT THE GENRL TABLE.                          244
  616 WRITE(6,1546)( GENRL(I), I = 1,15)                                     245
      WRITE(6,1611)                                                          246
C****         SECTION TO WRITE OUT THE DTIME TABLE.                          247
  639 WRITE(6,1539)(DTIME(K),K = 1,20)                                       248
      WRITE(6,1611)                                                          249
C****         SECTION TO WRITE OUT THE EPTAB TABLE.                          250
      WRITE(6,1550)(EPTAB(I),I = 1,10)                                       251
      WRITE(6,1611)                                                          252
C****         SECTION TO WRITE OUT THE CHART TABLE.                          253
  649 WRITE(6,1549)(CHART(J),J = 1,20)                                       254
      WRITE(6,1611)                                                          255
C****         SECTION TO WRITE OUT THE TMELT TABLE.                          256
      WRITE(6,1569)(TMELT(J),J = 1,18)                                       257
      WRITE(6,1611)                                                          258
C****         SECTION FOR THE OUTTB TABLE.                                   259
  653 WRITE(6,1553)(OUTTB(J),J = 1,25)                                       260
      WRITE(6,1611)                                                          261
C****         SECTION TO PRINT OUT THE SPACE OPTION.                         262
  652 WRITE(6,1552)(SPACE(J),J=1,10)                                         263
      WRITE(6,1611)                                                          264
C****         SECTION TO WRITE OUT THE AGPTB TABLE.                          265
  680 IF(JGAP) 690,700,690                                                   266
  690 WRITE(6,1559)                                                          267
C                                                                            268
      WRITE(6,1560)JGAP,(AGPTB(J),J=2,6)                                     269
      WRITE(6,1561)(AGPTB(J),J=10,15)                                        270
      WRITE(6,1562)(AGPTB(J),J = 7,9)                                        271
      WRITE(6,1611)                                                          272
C****         SECTION TO WRITE OUT BETA 4 CORRECTION TABLE.                  273
C                                                                            274
  700 IF(NOFTS) 710,725,710                                                  275
  710 WRITE(6,1620)                                                          276
      WRITE(6,1625) (TXQTAB(JD), JD = 1,NOFTS)                               277
      WRITE(6,1611)                                                          278
      LIMOUT = NOFTS + 1                                                     279
      LIMOT1 = NOFTS + NOFXS                                                 280
      WRITE(6,1630) (TXQTAB(JD), JD = LIMOUT,LIMOT1)                         281
      WRITE(6,1611)                                                          282
      DO 715 JD = 2,NOFXS                                                    283
      LIMOUT = (JD-1)*NOFXS +NOFTS + 1                                       284
      LIMOT1 = JD*NOFXS + NOFTS                                              285
  715 WRITE(6,1635) (TXQTAB(JDH) , JDH = LIMOUT,LIMOT1)                      286
      WRITE(6,1611)                                                          287
C****         SECTION TO WRITE OUT VARIABLE T'P'DENSITY INPUT)               288
  725 IF(GENRL(4)) 733,730,733                                               289
  730 WRITE(6,1640)                                                          290
      WRITE(6,1645) (XFORT(JD) , JD = 1,NXT)                                 291
      WRITE(6,1611)                                                          292
      WRITE(6,1650) (TMT(JD) , JD = 1,NT)                                    293
      WRITE(6,1611)                                                          294
      WRITE (6,1655) (XFORP(JD) ,JD = 1,NXP)                                 295
      WRITE(6,1611)                                                          296
      WRITE(6,1660) (TMP(JD) , JD = 1,NP)                                    297
      WRITE(6,1611)                                                          298
      WRITE (6,1665) (XFORDN(JD) , JD = 1,ND)                                299
      WRITE(6,1611)                                                          300
      WRITE (6,1670) (TMDENS(JD) ,JD = 1,NXD)                                301
      WRITE(6,1611)                                                          302
  733 IF(AMPLCT(2)) 735,740,735                                              303
  735 WRITE (6,1611)                                                         304
      WRITE (6,1675) (AMPLCT(I),I = 1,10)                                    305
  740 IF(BACKFC(1)) 745,1000,745                                             306
  745 WRITE(6,1611)                                                          307
      WRITE (6,1680) (BACKFC(I) ,I= 1,4)                                     308
 1000 RETURN                                                                 309
C****         SECTION FOR FORMAT STATEMENTS.                                 310
 1500 FORMAT(1H1,12A6)                                                       311
 1501 FORMAT (1H055X,12HINPUT TABLES)                                        312
 1502 FORMAT (1H033X,6HLAYER I2)                                             313
 1505 FORMAT (1H03X,4HTEMP,9X,6HCP TAB,7X,5HK TAB,8X,8HDKDT TAB,5X,5HC T     314
     1AB)                                                                    315
 1506 FORMAT(5E13.4)                                                         316
 1508 FORMAT (1H03X,4HTEMP,9X,3HHGF,10X,3HCPG,10X,3HHCG,9X,4HMBAR,10X,5H     317
     1MBARP,8X,4HCPBL,9X,3HEFF)                                              318
 1509 FORMAT(8E13.4)                                                         319
 1512 FORMAT (1H03X,13HDENSITY TABLE,4X,1HZ,13X,1HE,13X,2HZ1,12X,2HE1)       320
 1513 FORMAT(5E13.4)                                                         321
 1531 FORMAT (1H0,3X,4HTIME,9X,8HTTABL(1),6X,8HTTABL(2),6X,8HTTABL(3),6X     322
     1,8HTTABL(4),6X,8HTTABL(5))                                             323
 1532 FORMAT (1H0,3X,4HTIME,9X,8HTTABL(6),6X,8HTTABL(7),6X,8HTTABL(8),6X     324
     1,8HTTABL(9),6X,9HTTABL(10))                                            325
 1533 FORMAT(7E13.4)                                                         326
 1539 FORMAT(1H0,3X,14HDTIME TABLE = 5E18.5)                                 327
 1542 FORMAT (1H03X,5HLAYER,5X,12HINTERIOR PTS,4X,9HTHICKNESS,7X,8HDENSI     328
     1TYS)                                                                   329
 1543 FORMAT (I6,F17.0,E19.3,E15.3)                                          330
 1546 FORMAT(1H03X,13HGENRL TABLE = 5E18.5)                                  331
 1549 FORMAT (1H03X,13HCHART TABLE = 5E18.5)                                 332
 1550 FORMAT (1H03X,13HEPTAB TABLE = 5E18.5)                                 333
 1552 FORMAT(1H03X,13HSPACE TABLE = 5E18.5)                                  334
 1553 FORMAT (1H03X,13HOUTTB TABLE = 5E18.5)                                 335
 1559 FORMAT (1H045X,16HAIRGAP PROPERTYS)                                    336
 1560 FORMAT(1X,6HLAYER=I2,3X,3HFE=E10.3,3X,3HFA=E10.3,3X,9HEFF COND=E10     337
     1.3,3X,5HVISC=E10.3,3X,7HHEIGHT=E10.3)                                  338
 1561 FORMAT(13H EXP. OF X/L=E10.3,2X,9HTRIP NO.=E10.3,2X,11HCOEF(-,+)=(     339
     1E10.3,1H,E10.3,1H),2X,10HEXP(-,+)=(E10.3,1H,E10.3,1H))                 340
 1562 FORMAT(1H 1X,5HG1 = E15.8,3X,5HG2 = E15.8,3X,5HG3 = E15.8)             341
 1563 FORMAT (1H03X,4HTEMP,9X,6HCP TAB,7X,5HK TAB,8X,8HDKDT TAB,5X,5HC T     342
     1AB,8X,7HALPHA T,7X,10HE-MOD(IN.))                                      343
 1564 FORMAT(7E13.4)                                                         344
 1567 FORMAT(1H0,3X,11HSTVAR(1) = E15.8,4X,9HT(REF) = E15.8,4X,8HT(AB) =     345
     1 E15.8)                                                                346
 1568 FORMAT(1H0,3X,8HTRAJT = 5E18.5)                                        347
 1569 FORMAT (1H03X,13HTMELT TABLE = 5E18.5)                                 348
 1600 FORMAT (1H03X,11HPROPT(1) = 1A6,3X,11HPROPT(2) = 1A6,3X,11HPROPT(3     349
     1) = 1A6,3X,11HCTABL(1) = 1A6)                                          350
 1601 FORMAT (1H03X,11HGASPR(1) = 1A6,3X,11HGASPR(2) = 1A6,3X,11HGASPR(3     351
     1) = 1A6,3X,11HGASPR(4) = 1A6)                                          352
 1602 FORMAT (1H03X,11HGASPR(5) = 1A6,3X,11HHTABL(1) = 1A6,3X,11HHTABL(2     353
     1) = 1A6)                                                               354
 1603 FORMAT (1H0,3X,11HALPHT(1) = 1A6,3X,11HEMOD(1) = 1A6)                  355
 1604 FORMAT (1H03X,11HTTABL(1) = 1A6,3X11HTTABL(2) = 1A6,3X,11HTTABL(3)     356
     1 = 1A6,3X,11HTTABL(4) = 1A6)                                           357
 1605 FORMAT (1H03X,11HTTABL(5) = 1A6,3X,11HTTABL(6) = 1A6,3X,11HTTABL(7     358
     1) = 1A6,3X,11HTTABL(8) = 1A6)                                          359
 1606 FORMAT (1H03X,11HTTABL(9) = 1A6,3X,12HTTABL(10) = 1A6)                 360
 1607 FORMAT (1H0,3X,11HZORET(1) = 1A6,3X,11HZORET(2) = 1A6)                 361
 1608 FORMAT(1H0,15H***************,3X,17HTEMP. DEP. TABLES,3X,15H******     362
     1********* )                                                            363
 1609 FORMAT(1H0,15H***************,3X,17HTIME  DEP. TABLES,3X,15H******     364
     1********* )                                                            365
 1610 FORMAT(1H0,15H***************,3X,17HDENS. DEP. TABLES,3X,15H******     366
     1********* )                                                            367
 1611 FORMAT(1H0,25H*************************)                               368
 1620 FORMAT(1H0,15H***************,3X,17HBETA 4 .Q. TABLES,3X,15H******     369
     1*********)                                                             370
 1625 FORMAT(1H0,3X,13HIND T TABLE =5E18.5)                                  371
 1630 FORMAT(1H0,3X,13HIND X TABLE =5E18.5)                                  372
 1635 FORMAT(1H0,3X,13HDEP Q TABLE =5E18.5)                                  373
 1640 FORMAT(1H0,15H***************,3X,17HT  P  DENS TABLES,3X,15H******     374
     1*********)                                                             375
 1645 FORMAT(1H0,3X,13HXFORT TABLE =5E18.5)                                  376
 1650 FORMAT(1H0,3X,13HTEMPS TABLE =5E18.5)                                  377
 1655 FORMAT(1H0,3X,13HXFORP TABLE =5E18.5)                                  378
 1660 FORMAT(1H0,3X,13HPRESS TABLE =5E18.5)                                  379
 1665 FORMAT(1H0,3X,13HXFORD TABLE =5E18.5)                                  380
 1670 FORMAT(1H0,3X,13HDENS. TABLE =5E18.5)                                  381
 1675 FORMAT(1H0,3X,13HAMPLCT TABLE=5E18.5)                                  382
 1680 FORMAT(1H0,13HBACKFC TABLE=4E18.5)                                     383
      STOP                                                                   384
      END                                                                    385
TV001-TV001-00000000000000000000000000000000000000000000000000000000000000000000
$ORIGIN        ALPHA
$IBFTC AIRGAP
      SUBROUTINE AIRGAP                                                        1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE AIR-GAP EQUATIONS ARE DEFINED AND DISCUSSED IN              62
C****         SECTION IV OF THE ANALYSIS.                                     63
C                       TEST IF KTIME = 1.                                    64
C                       SET UP COUNTERS FOR                                   65
C                       FIRST TIME THROUGH                                    66
      KTIME = KONVAR(2)                                                       67
      IF (KTIME-1) 10,5,10                                                    68
    5 JGAP = KONVAR(5)                                                        69
      J1 = JGAP+1                                                             70
      NTEMP = INDTL(4)                                                        71
      LAYER = KONVAR(4)                                                       72
      ITIME = KONVAR(1)                                                       73
      J2 = JGAP-1                                                             74
      MN = JLAYER(JGAP)+1                                                     75
   10 II = KONVAR(6)*KONVAR(1)+MN                                             76
      JJ = II-ITIME                                                           77
      KK = JJ-ITIME                                                           78
C                       COMPUTE TERMS IN THE C COEFFICIENTS                   79
C                       THAT REMAIN CONSTANT THROUGOUT                        80
C                       THE ITERATIONS.                                       81
   11 AGTAV = (T(II)+T(II+1))/2.                                              82
C                       USE TABLE LOOK-UP TO GET THE FOLLOWING                83
C                       1.  THE K FOR THE (J-1) LAYER = CAYL.                 84
C                       2.  THE K FOR THE (J+1) LAYER = CAYR.                 85
C                       3.  THE C(P) FOR THE AIR-GAP = AGCP.                  86
C                       4.  THE RHO-C(PL) OF THE (J-1) LAYER = RCPLL.         87
C                       5.  THE RHO-C(PL) OF THE AIR-GAP = RCPLAG.            88
C                       6.  THE K FOR THE AIR-GAP = CAYAG                     89
      MN1 = (NTEMP+1)*(3*(J2-1)+1)+1                                          90
      CALL TABUP(WARM,PROPT(MN1),T(II),CAYL,NTEMP,1)                          91
C                       TEST TO SEE IF AIR-GAP IS LAST LAYER.                 92
      IF (JGAP-LAYER) 18,16,18                                                93
   16 B2 = 0.                                                                 94
      GO TO 19                                                                95
   18 MN4 = (NTEMP+1)*(3*(J1-1)+1)+1                                          96
      CALL TABUP(WARM,PROPT(MN4),T(II+1),CAYR,NTEMP,1)                        97
      B2 = -CAYR/THIKN(J1)/2./DELETA(J1)                                      98
   19 CALL TABUP(WARM,CTABL,T(II),RCPLL,NTEMP,J2)                             99
      CALL TABUP(WARM,CTABL,T(II+1),RCPLAG,NTEMP,JGAP)                       100
      B1 = -CAYL*ETASBX(MN)/2./DELETA(J2)                                    101
      MN3 = (NTEMP+1)*(3*(JGAP-1))+1                                         102
      CALL TABUP(WARM,PROPT(MN3),AGTAV,AGCP,NTEMP,1)                         103
      RCPA2 = DENSE(JGAP)*AGCP*THIKN(JGAP)/2.                                104
      TMP1 = RCPLAG+RCPA2                                                    105
      TMP2 = RCPLL+RCPA2                                                     106
C****          SEE IF 2 PT. OR 3 PT. FORMULA IS TO BE USED.                  107
C****          GENRL(6) = - , USE 2 PT.     IF =  +  USE 3 PT.               108
      IF(GENRL(6)) 21,23,23                                                  109
   21 ALF3 = 0.0                                                             110
      GO TO 24                                                               111
   23 ALF3 = 1.0                                                             112
   24 BC1 = (2.+ALF3)*B2 - GAMMA(6)*TMP1                                     113
      BC2 = (2.+ALF3)*B1 - GAMMA(6)*TMP2                                     114
      BC5 = 1./((2.+ALF3)*B1 - RCPLL*GAMMA(6))                               115
      B3 = TMP1*(GAMMA(4)*T(KK+1)+GAMMA(5)*T(JJ+1))                          116
      B4 = TMP2*(GAMMA(4)*T(KK)+GAMMA(5)*T(JJ))                              117
      B5 = RCPLL*(GAMMA(4)*T(KK)+GAMMA(5)*T(JJ))                             118
C                       ITERATION SCHEME WILL START HERE.                    119
      EP1 = -EPTAB(4)                                                        120
      TX5 = T(II)                                                            121
      TX5I = T(II)                                                           122
   26 TX6 = T(II+1)                                                          123
      EPS = -EPTAB(4)                                                        124
  261 CONTINUE                                                               125
      IF (KONVAR(3)-2) 28,27,28                                              126
   27 CALL INTPTS(JGAP,2)                                                    127
   28 TMP3 = ((2.+2.*ALF3)*T(II-1)-ALF3*T(II-2))*B1                          128
      BC3 = B2*((2.+2.*ALF3) * T(II+2) -ALF3*T(II+3)) +TMP3 + B3 + B4        129
C****         T(II+1) IS DEFINED IN EQUATION IV.22                           130
      T(II+1) = (BC3-BC2*T(II))/BC1                                          131
      IF (KONVAR(3)-2) 30,29,30                                              132
   29 CALL TNEST(T(II+1),TX6,EPS)                                            133
      EPS = ABS(EPS)                                                         134
      KTX6 = TX6                                                             135
      GO TO (30,261,127),KTX6                                                136
  127 WRITE(6,500)  BC1,BC2,BC3,BC4,BC5,B1,B2,B3,B4,B5,T(II)                 137
      GO TO 261                                                              138
   30 BC4 = BC5*(B1*((2.+2.*ALF3)*T(II-1)-ALF3*T(II-2))+B5)                  139
C                       BLOCK FOR BAR-C-6.                                   140
      CALL QGAP(BC6,QDCOND,QR,QCR)                                           141
      BC6 = BC6*(T(II)-T(II+1))                                              142
C****         T(II) IS DEFINED IN EQUATION IV.21                             143
      T(II) = BC4+BC5*BC6                                                    144
      CALL TNEST(T(II),TX5,EP1)                                              145
      EP1 = ABS(EP1)                                                         146
      COUNT(13) = COUNT(13) + 1.                                             147
      KTX5 = TX5                                                             148
      GO TO (60,26,55),KTX5                                                  149
   55 WRITE(6,501)  QDCOND,QR,QCR,BC4,BC5,BC6,T(II+1)                        150
      GO TO 26                                                               151
   60 RETURN                                                                 152
  500 FORMAT (1H0,4X,9HC BARS = 5E20.8//7X,6HB-S = 5E20.8//5X,8HT(II) =      153
     1E18.8)                                                                 154
  501 FORMAT (1H0,4X,5HQC = E18.8,3X,5HQR = E18.8,3X,6HQCR = E18.8//3X,6     155
     1HBC4 = E18.8,2X,6HBC5 = E18.8,3X,6HBC6 = E18.8//3X,10HT(II+1) = E1     156
     28.8)                                                                   157
      STOP                                                                   158
      END                                                                    159
$IBFTC DELTAT
      SUBROUTINE DELTAT(K)                                                     1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C                       THIS ROUTINE CALCULATES THE DELTA                     62
C                       T FOR THE TIME STEP                                   63
C                       K IS A COUNTER WHICH DETERMINES                       64
C                       IF DELTA T IS CHOSEN FROM TABLE                       65
C                       (K=0) OR MUST BE MODIFIED (K=1).                      66
      KAY = K                                                                 67
      KTIME = KONVAR(2)                                                       68
      NLAYER = KONVAR(4)                                                      69
      IF(KAY) 180, 2, 200                                                     70
C****     THIS COUNT IS RESET EACH TIME KAY IS ZERO                           71
    2 KOUNTR = 0                                                              72
C                       GET CORRECT DELTA BAR FROM DTIME(X).                  73
      DO 4 I = 1,10                                                           74
      N = 2*I                                                                 75
      N1 = N-1                                                                76
      IF(DTIME(N) - CTIME - DELTO(KTIME)) 4,4,3                               77
    3 DELBAR = DTIME(N1)                                                      78
      GO TO 30                                                                79
    4 CONTINUE                                                                80
C                       SET DELTO(KTIME) = DELBAR                             81
   30 TEST1 = ABS(ETASBT(1))                                                  82
      LMSRCH = KONVAR(1)                                                      83
      DO 35 IJSRCH = 1, LMSRCH                                                84
      IF (TEST1-ABS(ETASBT(IJSRCH))) 31,33,33                                 85
   31 TEST1 = ABS(ETASBT(IJSRCH))                                             86
   33 IF (TEST1-ABS(BETA(3,IJSRCH))) 34,35,35                                 87
   34 TEST1 = ABS(BETA(3,IJSRCH))                                             88
   35 CONTINUE                                                                89
      DELTO(KTIME) = DELBAR                                                   90
      IF(KTIME-1) 56, 56, 50                                                  91
   50 E1 = (1.+EPTAB(1))*DELTO(KTIME-1)                                       92
C                       KTIME IS GREATER THAN ONE.                            93
C                       SELECT CORRECT DELTO(KTIME).                          94
      DELZMN = AMIN1(DELBAR,E1)                                               95
      IF (DELBAR-DELTO(KTIME-1))  56,55,55                                    96
   55 DELTO(KTIME) = DELZMN                                                   97
   56 IF(ABS(TEST1*DELTO(KTIME)/DELETA(1))-1.) 180,58,58                      98
   58 DELTO(KTIME) = DELETA(1)*.95/ABS(TEST1)                                 99
      COUNT(15) = COUNT(15) + 1.                                             100
      IF(DELTO(KTIME) -.01*DELTO(KTIME-1)) 190,190,180                       101
  180 BB = -HTCONV(5) * ETASBX(1)                                            102
      KOUNTR = KOUNTR +1                                                     103
      IF (KOUNTR.GT.10) GO TO 191                                            104
C****     THE CONSTANT IN THE FOLLOWING STATEMENT                            105
C****     MUST BE LARGER THAN THE ONE IN STATEMENT 186                       106
      IF(ABS(DELTO(KTIME)*BB/DELETA(1))-.5) 200,200,184                      107
  184 IF(KAY.EQ.0) GO TO 186                                                 108
  185 CTIME = CTIME - DELTO(KTIME)                                           109
      K = 0                                                                  110
C****              COMPUTE R VALUES,ETA DERIVATIVES AND X LOCATIONS.         111
      CALL RITER(1)                                                          112
  186 DELTO(KTIME) = .45*DELETA(1)/ABS(BB)                                   113
C****     SEE PREVIOUS COMMENT CONCERNING CONSTANT                           114
      IF(KAY.EQ.0) GOTO 189                                                  115
      CTIME = CTIME + DELTO(KTIME)                                           116
  189 CONTINUE                                                               117
      COUNT(14) = COUNT(14) + 1.                                             118
      IF(DELTO(KTIME) - .01 * DELTO(KTIME-1)) 190, 190, 200                  119
  190 WRITE (6,500)                                                          120
      CALL EXIT                                                              121
  191 WRITE (6,501)                                                          122
      CALL EXIT                                                              123
  200 IF (TIVAR(10)) 205,240,205                                             124
C****     THE CONSTANT IN STATEMENT NUMBER 205 MUST BE GREATER               125
C****     THAN THE ONE IN STATEMENT NUMBER 225                               126
  205 IF (DELTO(KTIME) - .50*DELETA(1)/TIVAR(10)) 230, 230, 225              127
  225 DELTO(KTIME) = .45 * DELETA(1)/ TIVAR(10)                              128
      COUNT(14) = COUNT(14) +1.                                              129
  230 TIVAR(10) = 0.0                                                        130
C****         SEE IF IMPLICIT SCHEME IS REQUESTED FOR THIS TIME STEP.        131
  240 CONTINUE                                                               132
      IMPTME = 0                                                             133
  245 IF (CTIME - AMPLCT(IMPTME+1)) 260,250,250                              134
  250 IF (CTIME - AMPLCT(IMPTME+2)) 255,258,258                              135
C****         AT 255 THE IMPLICIT SCHEME HAS BEEN REQUESTED                  136
C****         FOR THIS TIME STEP.                                            137
  255 IMEX = -1                                                              138
      GO TO 400                                                              139
  258 IMPTME = IMPTME + 2                                                    140
      IF (IMPTME.LE.8 ) GO TO 245                                            141
C****         AT 260 THE IMPLICIT SCHEME HAS NOT BEEN REQUESTED              142
C****         FOR THIS TIME STEP SO DECIDE BETWEEN EXP. AND EXP-IMP.         143
C****         J = THE LAYER.                                                 144
C****         MN = THE X LOCATION   MN IS THE TRUE MN.                       145
  260 DO 268 J = 1,NLAYER                                                    146
      MNBGIN = JLAYER(J) + 2                                                 147
      TEST = BETA(1,MNBGIN)                                                  148
      MNBGIN = MNBGIN + 1                                                    149
      MNSTOP = JLAYER(J+1)                                                   150
      DO 263 MN = MNBGIN , MNSTOP                                            151
      IF(TEST - BETA(1,MN))  262,263,263                                     152
  262 TEST = BETA(1,MN)                                                      153
  263 CONTINUE                                                               154
C****WE NOW HAVE THE LARGEST BETA FOR LAYER J.                               155
      IF(J-1)  266,265,266                                                   156
  265 DELGES = DELETA(J)**2/(2.*TEST)                                        157
      GO TO 268                                                              158
  266 TSTDEL = DELETA(J)**2/(2.*TEST)                                        159
      IF(TSTDEL - DELGES)  267,268,268                                       160
  267 DELGES = TSTDEL                                                        161
  268 CONTINUE                                                               162
      IF(DELGES - DELTO(KTIME)) 275,270,270                                  163
  270 IMEX = 1                                                               164
      KONVAR(3) = 3                                                          165
      GO TO 400                                                              166
  275 IMEX = 0                                                               167
  400 RETURN                                                                 168
  500 FORMAT(1H0,4X,28HDT CUT 2 ORDERS OF MAGNITUDE  )                       169
  501 FORMAT(1H0,4X,29H ITERATING TOO MUCH IN DELTAT)                        170
      END                                                                    171
$IBFTC GAMA
      SUBROUTINE GAMA(HH)                                                      1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATIONS FOR THE APPROXIMATION COEFFICIENTS ARE            62
C****         DEFINED AND DISCUSSED IN SECTION IV,THE INTERFACE               63
C****         EQUATIONS.                                                      64
C                       THIS SUBROUTINE CALCULATES THE                        65
C                       APPROXIMATION COEFFICIENTS CALLED                     66
C                       GAMMA(4-6).                                           67
C****         GAMMA(1-3) ARE AVAILABLE FOR FUTURE MODIFICATION.               68
      H=HH                                                                    69
      KTIME = KONVAR(2)                                                       70
    1 H = -H                                                                  71
      VRDEL2 = DELTO(KTIME)                                                   72
      GO TO (2,3,3),KTIME                                                     73
    2 GAMMA(4) = 0.0                                                          74
      GAMMA(5) = -1./VRDEL2                                                   75
      GAMMA(6) = 1./VRDEL2                                                    76
      GO TO 4                                                                 77
    3 VRDEL1 = DELTO(KTIME-1)                                                 78
      GAMMA(4) = VRDEL2/(VRDEL1*(VRDEL1+VRDEL2))                              79
      GAMMA(5) = -(VRDEL1+VRDEL2)/(VRDEL1*VRDEL2)                             80
      GAMMA(6) = (VRDEL1+2.*VRDEL2)/(VRDEL2*(VRDEL1+VRDEL2))                  81
    4 RETURN                                                                  82
      END                                                                     83
$IBFTC INTFC
      SUBROUTINE INTFC                                                         1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATIONS OF THIS ROUTINE ARE DEFINED AND                   62
C****         DISCUSSED IN SECTION IV, NUMERICAL SOLUTIONS OF ENERGY          63
C****         EQUATIONS AND BOUNDARY CONDITIONS.                              64
C                       THIS SUBROUTINE CALCULATES THE                        65
C                       INTER-FACE AND BACK-FACE                              66
C                       TEMPERATURES AND PRESSURES.                           67
C                       SUBROUTINE GAMA,CALLED WITH A                         68
C                       (-) ARGUEMENT, CALCULATES GAMMA(1-6).                 69
      ITIME = KONVAR(1)                                                       70
      KTIME = KONVAR(2)                                                       71
      LAYER = KONVAR(4)                                                       72
      JGAP = KONVAR(5)                                                        73
      N3 = KONVAR(6)                                                          74
      NTEMP = INDTL(4)                                                        75
      NTIME = INDTL(5)                                                        76
C****          SEE IF 2 PT. OR 3 PT. FORMULA IS TO BE USED.                   77
C****          GENRL(6) = - , USE 2 PT.     IF =  +  USE 3 PT.                78
      IF(GENRL(6)) 2,3,3                                                      79
    2 ALF3 = 0.0                                                              80
      GO TO 4                                                                 81
    3 ALF3 = 1.0                                                              82
    4 DO 30 J = 1,LAYER                                                       83
C                       LOOP COMPUTES INTERFACE TEMPERATURES.                 84
      L = J+1                                                                 85
      TIVAR(5) = 0.                                                           86
      IF (L-JGAP) 5,30,5                                                      87
    5 IF (JGAP+1-L) 7,30,7                                                    88
    7 NPTS = PTSIN(J)+1.                                                      89
      MN = JLAYER(J)+NPTS+1                                                   90
      II = N3*ITIME+MN                                                        91
      JJ = II-ITIME                                                           92
      KK = JJ-ITIME                                                           93
      TY4 = T(II)                                                             94
      EPS = -EPTAB(5)                                                         95
    8 MN1 = (NTEMP+1)*(3*(J-1)+1)+1                                           96
      CALL TABUP(WARM,PROPT(MN1),T(II),CAY1,NTEMP,1)                          97
      BBAR1 = -CAY1*ETASBX(MN)/DELETA(J)/2.                                   98
      IF (J-LAYER) 22,10,22                                                   99
   10 BBAR2 = 0.                                                             100
      CALL TABUP(HORA,TTABL,CTIME,TIVAR(5),NTIME,5)                          101
      IF (GENRL(7)) 20,23,20                                                 102
   20 T(II) = TIVAR(5)                                                       103
      GO TO 23                                                               104
   22 MN1 = (NTEMP+1)*(3*(L-1)+1)+1                                          105
      CALL TABUP(WARM,PROPT(MN1),T(II),CAY2,NTEMP,1)                         106
      BBAR2 = -CAY2*ETASBX(MN+1)/DELETA(L)/2.                                107
C                       TEST IF ROUTINE MUST                                 108
C****                   CALL INTPTS.                                         109
   23 IF (KONVAR(3)-2) 26,24,26                                              110
   24 CALL INTPTS(L,2)                                                       111
C                       COMPUTE TERMS FOR TEMP. EQUATION.                    112
   26 TRM1 = BBAR1*((2.+2.*ALF3)*T(II-1) - ALF3*T(II-2))                     113
   27 IF(J-LAYER) 28,127, 127                                                114
  127 IF (GENRL(7)) 30,117,30                                                115
  117 QBFC = TIVAR(5)                                                        116
      GO TO 128                                                              117
   28 QBFC = 0.                                                              118
  128 TRM2 = BBAR2*((2.+2.*ALF3)*T(II+1) - T(II+2)*ALF3) + QBFC              119
      CALL TABUP(WARM,CTABL,T(II),SEEUP,NTEMP,J)                             120
      TRM3 = SEEUP*(GAMMA(4)*T(KK) + GAMMA(5)*T(JJ))                         121
C****         T(II) IS DEFINED IN EQUATION IV.14                             122
C****         WHEN BBAR2 = 0.0, T(II) IS DEFINED BY EQUATION IV.16.          123
      T(II) = (TRM1 + TRM2 + TRM3)/(BBAR1*(2.+ALF3) + BBAR2*(2.+ALF3)        124
     1-SEEUP*GAMMA(6))                                                       125
C                       CALL TNEST FOR ITERATION.                            126
      IF (KONVAR(3)-2) 30,29,30                                              127
   29 CALL TNEST(T(II),TY4,EPS)                                              128
      EPS = ABS(EPS)                                                         129
      KTY4 = TY4                                                             130
      GO TO (30,123,150),KTY4                                                131
  123 COUNT(9) = COUNT(9) + 1.                                               132
      GO TO 23                                                               133
  150 WRITE(6,500)  BBAR1,BBAR2,SEEUP,TRM1,TRM2,TRM3                         134
      GO TO 23                                                               135
   30 CONTINUE                                                               136
  131 NPTS2 = PTSIN(1) + 2.                                                  137
      MND = JLAYER(1) + NPTS2                                                138
      IID = KONVAR(6)*KONVAR(1) + MND                                        139
  233 IF(KONVAR(7)-2) 139, 133, 139                                          140
  133 CALL DPRESS(IID,MND,0)                                                 141
  139 RETURN                                                                 142
  500 FORMAT (1H0,4X,8HBBAR1 = E18.8,3X,8HBBAR2 = E18.8,3X,8HSEEUP = E18     143
     1.8//4X,7HTRM1 = E18.8,3X,7HTRM2 = E18.8,3X,7HTRM3 = E18.8)             144
      STOP                                                                   145
      END                                                                    146
$IBFTC PTX1
      SUBROUTINE PTX1                                                          1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATIONS IN THIS SUBROUTINE ARE DISCUSSED IN SECTION       62
C****         IV, PART B OF THE ANALYSIS.                                     63
C                       THIS SUBROUTINE CALCULATES                            64
C                       THE TEMPERATURE AND PRESSURE                          65
C                       OF THE FRONT FACE.                                    66
C****         K(RHO) IS NOT INCLUDED IN THE TEMPERATURE ITERATION.            67
      NTEMP = INDTL(4)                                                        68
      NTIME = INDTL(5)                                                        69
      II = KONVAR(6)*KONVAR(1) + 1                                            70
      CALL CHARP(II,1)                                                        71
    5 BARC1T = DELETA(1)/1.5/ETASBX(1)/CHARV(1)                               72
    7 TTIME = CTIME                                                           73
C****              TEST TO SEE IF FRONT FACE T IS READ IN.                    74
      IF(GENRL(5)) 107, 8, 8                                                  75
  107 CALL TABUP(HORA,TTABL,TTIME,TIVAR(1),NTIME,1)                           76
      T(II) = TIVAR(1)                                                        77
C****          SEE IF 2 PT. OR 3 PT. FORMULA IS TO BE USED.                   78
C****          GENRL(6) = - , USE 2 PT.     IF =  +  USE 3 PT.                79
    8 IF(GENRL(6)) 108,109,109                                                80
  108 ALF3 = 0.0                                                              81
      GO TO 110                                                               82
  109 ALF3 = 1.0                                                              83
  110 EPS = -EPTAB(3)                                                         84
      T1 = T(II)                                                              85
C                       TEST NZERO TO SEE IF                                  86
C                       SUBROUTINE MIDPTS NEEDS                               87
C                       TO BE CALLED.                                         88
    9 IF (KONVAR(3)-2) 15,10,15                                               89
   10 N4 = PTSIN(1)+1.                                                        90
      CALL INTPTS(1,N4)                                                       91
   15 C3 = 2. + ALF3                                                          92
      C2 =(2. + 2.*ALF3)/C3*T(II+1) - ALF3/C3*T(II+2)                         93
      IF (CHART(1)) 20,27,20                                                  94
C****         COMPUTE M-DOT-G IF CHARRING                                     95
   20 IF (IMEX) 21,21,22                                                      96
   21 CALL DENSIT(II,1,0)                                                     97
   22 CALL EMG(II)                                                            98
C****         COMPUTE THE Q OF THE FRONT FACE                                 99
   27 CALL QNET                                                              100
      IF(GENRL(5)) 38,28,28                                                  101
   28 N5 = KONVAR(2)+1                                                       102
C****         PRESSURE OPTION                                                103
      IF(KONVAR(7)-2) 18, 16, 18                                             104
   16 CALL DPRESS(II,1,0)                                                    105
      CALL KEFFS(II,1)                                                       106
      CAYUP = HTCONV(15)                                                     107
      GO TO 19                                                               108
   18 CALL TABUP(WARM,PROPT,T(II),CAYUP,NTEMP,2)                             109
   19 BARC1 = BARC1T/CAYUP                                                   110
      C1 = 3. * BARC1/C3                                                     111
C****         T(II) IS DEFINED IN EQUATION IV.11                             112
      T(II) = C1 * Q(N5,1) + C2                                              113
C****              TEST TO SEE IF FIXED MELTING T OPTION.                    114
      IF (KONVAR(8)-5) 32,29,32                                              115
   29 IF (HTCONV(5)) 32,32,30                                                116
   30 IF (T(II)-TMELT(2)) 32,32,31                                           117
   31 IF (EPS)35,32,32                                                       118
   32 T(II) = AMAX1(T(II),WARM(1))                                           119
      CALL TNEST(T(II),T1,EPS)                                               120
      EPS = ABS(EPS)                                                         121
      COUNT(5) = COUNT(5) + 1.                                               122
      JT1 = T1                                                               123
      GO TO (134,9,234),JT1                                                  124
  234 WRITE(6,500)ALF3,C1,C2,Q(N5,1),DENS(II),DENS(II+1),T(II+1),EMDG(1)     125
      GO TO 9                                                                126
  134 IF(T(II)-WARM(1)) 41, 41, 34                                           127
   34 IF (KONVAR(8)-5) 38,35,38                                              128
   35 T(II) = AMIN1 (T(II),TMELT(2))                                         129
      IF (TMELT(2)-T(II)) 38,36,38                                           130
C                       RECOMPUTE QUANTITIES INVOLVED IN THE                 131
C                       FRONT FACE TEMP. CALCULATIONS.                       132
   36 IF (KONVAR(3)-2) 38,37,38                                              133
   37 CALL INTPTS(1,N4)                                                      134
   38 IF ( CHART(1) .EQ. 0.0 ) GO TO 139                                     135
      CALL DENSIT(II,1,0)                                                    136
      IF(KONVAR(7)-2) 139,138,139                                            137
  138 CALL DPRESS(II,1,0)                                                    138
  139 CALL QNET                                                              139
   40 RETURN                                                                 140
   41 CALL ERROR(3,18H T(II) = WARM(1)     )                                 141
  500 FORMAT (1H0,4X,7HALF3 = E18.8,3X,5HC1 = E18.8,3X,5HC2 = E18.8,3X,8     142
     1HQDNET = E18.8//4X,10HDENS(1) = E18.8,3X,10HDENS(2) = E18.8,3X,7HT     143
     2(2) = E18.8,3X,9HMDG(1) = E18.8)                                       144
      STOP                                                                   145
      END                                                                    146
$IBFTC PTX12
      SUBROUTINE PTX12                                                         1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****         THE EQUATIONS USED IN THIS SUBROUTINE ARE DISCUSSED IN          62
C****         APPENDIX E, THIN SKIN OPTION, OF THE ANALYSIS.                  63
      KTIME = KONVAR(2)                                                       64
      II = KONVAR(6)*KONVAR(1) + 1                                            65
      JJ = II - KONVAR(1)                                                     66
      AK = 1.                                                                 67
      CPA = 1.                                                                68
      AKP = 0.                                                                69
      IF(KTIME-1) 5, 5, 10                                                    70
    5 T(JJ) = T(1)                                                            71
      T(II) = T(1)                                                            72
      DENS(JJ) = DENS(1)                                                      73
      DENS(II) = DENS(1)                                                      74
      GO TO 15                                                                75
   10 DELTR = DELTO(KTIME)/DELTO(KTIME-1)                                     76
      T(II) =(DELTR + 1.)*T(JJ)-DELTR*T(1)                                    77
      DENS(II) = (DELTR + 1.)*DENS(JJ)-DELTR*DENS(1)                          78
      CALL ABLATE(DELTO(KTIME))                                               79
   15 T1 = T(II)                                                              80
      EPS = -EPTAB(3)                                                         81
   20 N5 = KTIME + 1                                                          82
      CALL TABUP(WARM,PROPT,T(II),CP,INDTL(4),1)                              83
      BARC1 = DELTO(KTIME)/THIKN(1)/DENSE(1)/CP                               84
C****         COMPUTE THE Q OF THE FRONT FACE                                 85
      CALL QNET                                                               86
      T(II) = T(JJ)+BARC1*Q(N5,1)                                             87
      T(II) = AMAX1(T(II),WARM(1))                                            88
      CALL TNEST(T(II),T1,EPS)                                                89
      EPS = ABS(EPS)                                                          90
      COUNT(5) = COUNT(5) + 1.                                                91
      KT1 = T1                                                                92
      GO TO (50,20,30),KT1                                                    93
   30 WRITE(6,500) T(II),T(JJ),BARC1,Q(N5,1)                                  94
      GO TO 20                                                                95
   50 IF(T(II)-WARM(1)) 75, 75, 60                                            96
   60 IF(KONVAR(8)-5)68,65,68                                                 97
   65 T(II) = AMIN1(T(II),TMELT(2))                                           98
      IF(TMELT(2)-T(II)) 68, 66, 68                                           99
   66 CALL QNET                                                              100
   68 CALL ABLATE(0)                                                         101
      CALL OUTPUT(0)                                                         102
   72 RETURN                                                                 103
   75 CALL ERROR(3,18H T(II) = WARM(1)      )                                104
      GO TO 68                                                               105
  500 FORMAT(1H0,3X,8HT(II) = E18.8,3X,8HT(JJ) = E18.8,3X,8HBARC1 = E18.     106
     18,3X,7HQNET = E18.8)                                                   107
      STOP                                                                   108
      END                                                                    109
$IBFTC QGAP
      SUBROUTINE  QGAP(BC6,QDCOND,QR,QCR)                                      1
C****                         INPUT     COMMON                                 2
                                                                               3
      COMMON  /INPTC/  CHART( 25),   GASPR(105),  TDENS( 20),                  4
     1                   ZORET( 84)                                            5
                                                                               6
      COMMON  /INPTC /   INDTL( 25),   NATETB( 20),   NCTABL( 5),              7
     1                   NDGREE    ,   NGASPR(  5),   NHORA     ,              8
     2                  NHTABL( 2),    NNU   (  5),   NPHI      ,              9
     3                  NPROPT(30),    NTDENS     ,   NTTABL(10),             10
     4                  NWARM      ,   NZORET(  4)                            11
                                                                              12
      COMMON  /INPTC /   TMELT( 25),    TRAJT( 25)                            13
                                                                              14
      COMMON  /INPTC /  AGPTB( 25),    DENSE( 10),    DTIME (25),             15
     1                  EPTAB( 10),    GENRL( 25),    OUTTB( 25),             16
     2                  PTSIN( 10),    SPACE ( 10),   THIKN (10)              17
                                                                              18
      COMMON  /INPTC /   PVAR ( 50)                                           19
                                                                              20
      COMMON  /INPTC /  CTABL(210),    HTABL ( 42),   PROPT(630),             21
     1                  WARM ( 20)                                            22
                                                                              23
      COMMON  /INPTC /   HORA ( 50),    TTABL(510)                            24
                                                                              25
      COMMON  /INPTC /  AT    (150),   ATETB (420),   ATP  (150),             26
     1                  DGREE( 20),    E     (150),   EP   (150),             27
     2                  NU    (  5),   PHII  (105),   PPHIP(150),             28
     3                  PPHI2P(150),   SIGMA (150),   STRESS(150),            29
     4                  STVAR ( 25)                                           30
                                                                              31
                                                                              32
C****                              COMPUTATION COMMON                         33
                                                                              34
      COMMON  /CHARDT/   CHARV (  5),  SCHAR (  4)                            35
                                                                              36
      COMMON  /COUNTR/   COUNT ( 25)                                          37
                                                                              38
      COMMON  /HEATDP/   Q    (4,13)                                          39
                                                                              40
      COMMON  /LAYERD/   DELETA( 10),  JLAYER( 11)                            41
                                                                              42
      COMMON  /MELTDT/   SMELT (  4),  TRAJV ( 50)                            43
                                                                              44
      COMMON  /PHYSDT/   DELTO (  4),  SPACVR(  5),    GAMMA (  6)            45
                                                                              46
      COMMON  /POINTD/  BETA(4,150),   DENS  (450),   EMDG (150),             47
     1                  ETASBT(150),   ETASBX(150),   ETAXX(150),             48
     2                  P      (450),  T     (450),   WDOTP(150),             49
     3                  XLOC  (150)                                           50
                                                                              51
      COMMON  /TIMEDT/   CTIME     ,    TIME                                  52
                                                                              53
      COMMON  /VARIBL/   HTCONV( 25),   KONVAR( 25)                           54
      COMMON  /VARIBL/  TIVAR(10)   ,  PROP    (3),   HEVAR  (10)             55
                                                                              56
      COMMON  /OUTDPT/  AUS(25)                                               57
                                                                              58
      COMMON  /HEADG /  HEAD(14)                                              59
      COMMON/EXPIMP/ AMPLCT(10),IMEX,IMPTME,BACKFC(4)                         60
                                                                              61
C****          THIS SUBROUTINE COMPUTES THE Q OF THEAIRGAP.                   62
C****          THE EXPRESSION (T(II)-T(II+1)) HAS BEEN FACTORED               63
C****          OUT OF  QCR---QR---QDCOND.                                     64
      II = KONVAR(6)*KONVAR(1) + JLAYER(JGAP)+1                               65
      NTEMP = INDTL(4)                                                        66
      PT = CTIME-GENRL(1)                                                     67
      IF(KONVAR(2)-1)  10,5,10                                                68
    5 JGAP = KONVAR(5)                                                        69
      AGTAV = (T(II) + T(II+1))/2.                                            70
C                       COMPUTE COEFFICIENTS FOR                              71
C                       FOR PARABOLIC CURVE FIT.                              72
      G0 = AGPTB(7)                                                           73
      G1 = AGPTB(8)                                                           74
      G2 = AGPTB(9)                                                           75
      T1 = GENRL(2)-GENRL(1)                                                  76
      A1 = (G0-2.*G1+G2)*2./T1**2                                             77
      A2 = (-3.*G0+4.*G1-G2)/T1                                               78
      A3 = G0                                                                 79
      MN2 = (NTEMP+1)*(3*(JGAP-1)+1)+1                                        80
      CALL TABUP(WARM,PROPT(MN2),AGTAV,CAYAG,NTEMP,1)                         81
      MN3 = (NTEMP+1)*(3*(JGAP-1))+1                                          82
      CALL TABUP(WARM,PROPT(MN3),AGTAV,AGCP,NTEMP,1)                          83
   10 G = A1*PT**2+A2*PT+A3                                                   84
   15 QR = HTCONV(2)*AGPTB(2)*AGPTB(3)*(T(II)+T(II+1))*                       85
     1(T(II)**2+T(II+1)**2)                                                   86
   20 QDCOND = AGPTB(4)/THIKN(JGAP)                                           87
      BETDTM = 2.*(T(II)-T(II+1))/(T(II)+T(II+1))                             88
      BETDTM = ABS(BETDTM)                                                    89
      IF(G)  40,30,40                                                         90
   30 QCR = 0.0                                                               91
      GO TO 100                                                               92
   40 IF(AGPTB(5)) 41,30,41                                                   93
   41 GR = THIKN(JGAP)**3*DENSE(JGAP)**2*G*BETDTM/AGPTB(5)**2                 94
      IF(GR - AGPTB(11))  50,50,45                                            95
   45 C = AGPTB(13)                                                           96
      EN = AGPTB(15)                                                          97
      GO TO 70                                                                98
   50 C = AGPTB(12)                                                           99
      EN = AGPTB(14)                                                         100
   70 QCR = C*CAYAG/THIKN(JGAP)*(THIKN(JGAP)/AGPTB(6))**AGPTB(10)            101
      QCR = QCR*(GR*((AGCP*AGPTB(5))/CAYAG))**EN                             102
  100 BC6 = QCR + QR + QDCOND                                                103
      RETURN                                                                 104
      END                                                                    105
$IBFTC TMPIMP
      SUBROUTINE TMPIMP(LEM)                                                   1
C     THIS IS A DUMMY SUBROUTINE AND SHOULD NOT BE ENTERED                     2
      STOP                                                                     3
      END                                                                      4
$DATA
      TEST CASE 1  FRONT AND  BACK-FACE T READ IN WITH CHARRING.
 $REKAP THIKN=.0078,
 PTSIN=13,
 DENSE=62,
 DTIME=.1,10,.2,100,
 OUTTB=.01,1,1,100,
 HORA =0,.25,.5,.8,2,10,20,30,37,50,60,
 TTABL=530,632,690,727,790,833,874,931,971,961,952,0,0,0,
 530,530,530,530,530,562,597,624,642,665,681,
 0.,.0025,
 TMELT=1,
 WARM =529,7000.,
 GASPR=500,.60,0,30,0,
 PROPT=.4,.3E-4,0,
 HTABL=.24,.8,
 CHART=1,12.4,1,0,1,0,1,0,1,.72,1,
 TDENS=1,1000,
 ZORET=.106E13,.463E5,
 GENRL=0,60,.1,530,-1,1,1,
 NHTABL=1,1,
 NPROPT=1,1,1,
 NWARM=2,
 NHORA=11,
 NTTABL=11,1,1,1,11,1,1,
 NGASPR=1,1,1,1,1,
 NTDENS=2,
 END = 1,
 NZORET=1,1$
      TEST CASE 2  FRONT AND BACK-FACE T CALCULATED WITH CHARRING.
 $REKAP  DENSE=62,
 GENRL=0,60,-.1,530,0,-1,
 THIKN=.015,
 PTSIN=25,
 DTIME=.1,10,.2,100,
 OUTTB=1,80,.19,90,1,100,
 HORA =0,37.8,100,
 TTABL=5.5,1000,0,0,0,0,.0025,
 TMELT=1,
 WARM =529,7000,
 GASPR=500,.6,0,30,0,
 PROPT=.4,.3E-4,0,
 HTABL=.24,.8,
 CHART=1,12.4,1,20,0,0,0,0,1,.72,1,
 TDENS=1,1000,
 ZORET=.106E13,.463E5,
 NZORET=1,1,
 NTTABL=1,1,1,1,1,1,1,0,
 NTDENS=2,
 NGASPR=1,1,1,1,1,
 NHORA=3,
 NWARM=2,
 NPROPT=1,1,1,
 END = 1,
 NHTABL=1,1$
   TEST CASE 5 CHARRING AND FILM COEFFICIENT.
 $REKAP  DENSE=75,
 GENRL = 0,202,1,495,1,1,
 THIKN = .02795,
 PTSIN = 33,
 DTIME = 2,60,.5,130,.25,170,.5,202,
 OUTTB = 2,205,
 HORA = 0,10,20,40,60,70,80,90,100,110,120,130,140,150,160,170,180,190,
 200,202,
        TTABL =.000014,.000016,.000024,.000052,.000145,.00025,.000429,
    .000546,
 .000704,.000919,.001184,.001540,.006362,.010788,.018366,.028309,
 .030667,.03067,.026653,.026653,11804,11896,11977,12071,12123,
 12130,12119,12130,12113,12051,11930,11674,11164,10361,8522,5801,
 3065,1306,503,503,0,0,0,0,0,0,.0001,.0004,.0012,.0036,.0101,
 .0263,.0676,.1947,.2772,.0622,.011,.001,0,0,0,0,0,.00833,
 NTTABL=20,20,20,1,1,1,1,
 WARM = 400,1000,4000,7000,
 GASPR =  500,.6,0,60,
 PROPT = .4,.00003,
 HTABL = .24,.25,.3,.315,.8,.8,.8,.8,
 CHART = 1,22.5,2,-1,
 TDENS = 1,10000,
 NHORA = 20,NWARM = 4,NGASPR = 1,1,1,1,NPROPT = 1,1,
  NHTABL = 4,4,NTDENS = 2,NZORET = 1,1,
 END = 1,
 ZORET = 111000,37000$

